home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / foomatic-configure < prev    next >
Text File  |  2009-09-18  |  137KB  |  4,507 lines
  1. #!/usr/bin/perl -w
  2. use strict; # -*- perl -*-
  3.  
  4. # This is foomatic-configure, a program to establish and configure
  5. # print queues, drivers, spoolers, etc using the foomatic database and
  6. # companion filters.
  7.  
  8. # It also comprises half of a programatic API for user tools: you can
  9. # learn and control everything about the static properties of print
  10. # queues here. With the sister program foomatic-printjob, you can do
  11. # everything related to print queue dynamic state: submit jobs, and
  12. # query, cancel, reorder, and redirect them.
  13.  
  14. use Foomatic::Defaults;
  15. use Foomatic::DB;
  16. use Data::Dumper;
  17.  
  18. # Connect syntax:
  19. #
  20. # This differs a tad from CUPS's, partly because everything is
  21. # supposed to be a file, and CUPS doesn't entirely reflect that.
  22. # But I'm not really very particular...
  23. #
  24. # If a certain URI is not supported by all the spoolers, the spoolers
  25. # which support it are listed in parantheses, "direct" means direct, 
  26. # spooler-less printing.
  27. #
  28. # usb:/path/device                # Local USB printer
  29. # usb://make/model?serial=xxx     # Printer-bound USB connection (CUPS)
  30. # parallel:/path/device           # Local parallel printer
  31. # serial:/path/device             # Local serial printer
  32. # file:/path/file                 # includes usb, lp, named pipes, other
  33. # hp:/bus/model?serial=xxx        # HPLIP print queue (hpinkjet.sf.net)
  34. # hpfax:/bus/model?serial=xxx     # HPLIP fax queue (hpinkjet.sf.net)
  35. # ptal:/provider:bus:name         # HPOJ MLC protocol (hpoj.sf.net,obsolete)
  36. # mtink:/path/device              # Epson inkjet through mtink daemon
  37. #                                 # (for ink level monitoring when printing,
  38. #                                 #  http://xwtools.automatix.de/)
  39. # lpd://host/queue                # LPD protocol
  40. # lpd://host                      # LPD protocol (default queue, CUPS only)
  41. # socket://host:port              # TCP aka appsocket
  42. # socket://host                   # TCP aka appsocket (port 9100)
  43. # ncp://user:pass@host/queue      # Netware (LPD, LPRng, direct)
  44. # smb://user:pass@wgrp/host/queue # Windows (CUPS, PPR, LPD, LPRng, direct)
  45. # stdout                          # Standard output (direct)
  46. # postpipe:"<command line>"       # Free-formed backend command line
  47. #                                 # (LPD, LPRng, direct)
  48. #
  49.  
  50. # Read out the program name with which we were called, but discard the path
  51.  
  52. $0 =~ m!/([^/]+)\s*$!;
  53. my $progname = ($1 || $0);
  54. my $debug = 0;
  55.  
  56. # We use the library Getopt::Long here, so that we can have more than
  57. # one "-o" option on one command line.
  58.  
  59. my($opt_q, $opt_f, $opt_w, $opt_n, $opt_N, $opt_L, $opt_ppd,
  60.    $opt_d, $opt_p, $opt_s, $opt_C, $opt_R, $opt_D, $opt_Q, $opt_P,
  61.    $opt_O, $opt_X, $opt_c, @opt_o, $opt_r, $opt_dd, $opt_nodd, 
  62.    $opt_att, $opt_delay, $opt_h);
  63. use Getopt::Long;
  64. Getopt::Long::Configure("no_ignore_case");
  65. GetOptions("q"   => \$opt_q,         # Quiet, non-interactive operation
  66.        "f"   => \$opt_f,         # Force rebuild of PPD from database
  67.        "w"   => \$opt_w,         # Cut GUI strings in the PPD to 39
  68.                      # characters (for CUPS Windows driver)
  69.        "n=s" => \$opt_n,         # queue Name
  70.        "N=s" => \$opt_N,         # human-readable Name (Model, 
  71.                                  # Description)
  72.        "L=s" => \$opt_L,         # Location
  73.        "ppd=s" => \$opt_ppd,     # PPD file
  74.        "d=s" => \$opt_d,         # Driver
  75.        "p=s" => \$opt_p,         # Printer
  76.        "s=s" => \$opt_s,         # Spooler
  77.        "C"   => \$opt_C,         # Copy queue
  78.            "R"   => \$opt_R,         # Remove queue
  79.            "D"   => \$opt_D,         # set Default queue
  80.        "Q"   => \$opt_Q,         # Query queue info
  81.        "P"   => \$opt_P,         # Perl queue/printer/driver info output
  82.        "O"   => \$opt_O,         # get printer support Overview
  83.        "X"   => \$opt_X,         # query XML printer/driver/combo info
  84.        "c=s" => \$opt_c,         # printer Connection type
  85.        "o=s" => \@opt_o,         # default printing Options
  86.        "r"   => \$opt_r,         # list Remote queues
  87.        "backend-dont-disable=s" => \$opt_dd, # Do not disable CUPS 
  88.                                  # backends
  89.        "backend-attempts=s" => \$opt_att, # Try that often when backend
  90.                                  # fails
  91.        "backend-delay=s" => \$opt_delay, # Delay in seconds between
  92.                                  # retries of failed backend
  93.        "h"   => \$opt_h,         # Help!
  94.        "help"=> \$opt_h) || help();
  95.  
  96. help() if $opt_h;
  97.  
  98. my $db = new Foomatic::DB;
  99.  
  100. overview() if $opt_O;
  101.  
  102. get_xml() if $opt_X;
  103.  
  104. my $force = ($opt_f ? 1 : 0); 
  105.  
  106. my $shortgui = ($opt_w ? 1 : 0); 
  107.  
  108. my $in_config = {'queue'    => $opt_n,
  109.          'desc'     => $opt_N,
  110.          'loc'      => $opt_L,
  111.          'ppdfile'  => $opt_ppd,
  112.          'driver'   => $opt_d,
  113.          'printer'  => $opt_p,
  114.          'spooler'  => $opt_s,
  115.          'connect'  => $opt_c,
  116.          'options'  => \@opt_o,
  117.          'force'    => $force,
  118.          'shortgui' => $shortgui,
  119.          'dd'       => $opt_dd,
  120.          'att'      => $opt_att,
  121.          'delay'    => $opt_delay,
  122.              'foomatic' => 1};
  123.  
  124. # If description and location contain only whitespace, use an empty string
  125. # instead
  126.  
  127. if ((defined($in_config->{'desc'})) && ($in_config->{'desc'} =~ m!^\s*$!)) {
  128.     $in_config->{'desc'} = "";
  129. }
  130. if ((defined($in_config->{'loc'})) && ($in_config->{'loc'} =~ m!^\s*$!)) {
  131.     $in_config->{'loc'} = "";
  132. }
  133.  
  134. my $action = ($opt_R ? 'delete' : 'configure');
  135. $action = ($opt_D ? 'default' : $action);
  136. $action = ($opt_Q ? 'query' : $action);
  137. $action = ($opt_P ? 'query' : $action);
  138.  
  139. my $procs = { 'lpd' => { 'delete'    => \&delete_lpd,
  140.                          'configure' => \&setup_lpd,
  141.                          'default'   => \&default_lpd,
  142.                          'query'     => \&query_lpd },
  143.               'lprng'=>{ 'delete'    => \&delete_lpd,
  144.                          'query'     => \&query_lpd,
  145.                          'default'   => \&default_lprng,
  146.                          'configure' => \&setup_lpd },
  147.               'cups' =>{ 'delete'    => \&delete_cups,
  148.                          'query'     => \&query_cups,
  149.                          'default'   => \&default_cups,
  150.                          'configure' => \&setup_cups },
  151.               'pdq'  =>{ 'delete'    => \&delete_pdq,
  152.                          'query'     => \&query_pdq,
  153.                          'default'   => \&default_pdq,
  154.                          'configure' => \&setup_pdq },
  155.               'ppr'  =>{ 'delete'    => \&delete_ppr,
  156.                          'query'     => \&query_ppr,
  157.                          'default'   => \&default_ppr,
  158.                          'configure' => \&setup_ppr },
  159.               'direct'=>{'delete'    => \&delete_direct,
  160.                          'query'     => \&query_direct,
  161.                          'default'   => \&default_direct,
  162.                          'configure' => \&setup_direct } };
  163.  
  164. if (!($opt_Q or $opt_P or defined($in_config->{'queue'}))) {
  165.     # No queue manipulation without knowing the name of the queue
  166.     print STDERR "You must specify a queue name with -n!\n";
  167.     help();
  168.     exit 1;
  169. }
  170.  
  171. if (!defined($in_config->{'spooler'})) {
  172.  
  173.     my $takenfromconfigfile = 0;
  174.  
  175.     # Personal default spooler
  176.     my $s;
  177.     if (($> != 0) && (-f "$ENV{'HOME'}/.defaultspooler")) {
  178.         $s = `cat $ENV{'HOME'}/.defaultspooler`;
  179.         chomp $s;
  180.     $takenfromconfigfile = 1;
  181.     }
  182.  
  183.     # System default spooler
  184.     if ((!defined($s)) && (-f "$sysdeps->{'foo-etc'}/defaultspooler")) {
  185.         $s = `cat $sysdeps->{'foo-etc'}/defaultspooler`;
  186.         chomp $s;
  187.     $takenfromconfigfile = 1;
  188.     }
  189.  
  190.     if (!defined($s)) {
  191.     $s = detect_spooler();
  192.     }
  193.  
  194.     die "Unable to identify spooler, please specify with -s\n"
  195.     unless $s;
  196.  
  197.     if ((!$opt_q) && (!$takenfromconfigfile)) {
  198.     print STDERR "You appear to be using $s.  Correct? ";
  199.     my $yn = <STDIN>;
  200.     die "\n" if ($yn !~ m!^y!i);
  201.     }
  202.  
  203.     $in_config->{'spooler'} = $s;
  204. }
  205.  
  206. if ($in_config->{'printer'}) {
  207.     # If the user supplies an old numerical printer ID, translate it to
  208.     # a new clear-text ID
  209.     $in_config->{'printer'} =
  210.     Foomatic::DB::translate_printer_id($in_config->{'printer'});
  211. }
  212.  
  213. # Call proper proc
  214. &{$procs->{$in_config->{'spooler'}}{$action}}($in_config);
  215. exit(0);
  216.  
  217. # Common parts for queue creation/modification functions
  218.  
  219. sub getoldqueuedata {
  220.  
  221.     my ($config, $reconf) = @_;
  222.     my ($sourcespooler, $sourcequeue, $olddatablob, $beh);
  223.  
  224.     # Copy a queue
  225.     if ($opt_C) {
  226.     if ($#ARGV == 0) {  # 1 argument -> queue from same spooler
  227.         $sourcespooler = $config->{'spooler'};
  228.         $sourcequeue = $ARGV[0];
  229.     } elsif ($#ARGV == 1) {  # 2 arguments -> queue from given spooler
  230.         $sourcespooler = $ARGV[0];
  231.         $sourcequeue = $ARGV[1];
  232.     } else {
  233.         die "Unsufficient options to copy a queue, " .
  234.         "try \"$progname -h\"!\n";
  235.     }
  236.     # Read data from source queue
  237.     if (!($olddatablob = load_datablob($sourcespooler, $sourcequeue))) {
  238.         # It is not possible to copy the given source queue
  239.         die "The source queue $sourcequeue does not exist " .
  240.         "or is corrupted!\n";
  241.     }
  242.     # PPD file of the source queue, if it exists, and if the user
  243.     # does not insist on using another PPD file, we must copy it
  244.     my $sourceppd = $olddatablob->{'ppdfile'};
  245.     if ((-r $sourceppd) && (!$config->{'ppdfile'})) {
  246.         $config->{'ppdfile'} = $sourceppd;
  247.     }
  248.     # Stuff data into the $config structure, all items must be defined,
  249.     # so that an old queue gets overwritten
  250.     if ($olddatablob->{'queuedata'}) {
  251.          my $i;
  252.         for $i (('desc', 'loc', 'printer', 'driver', 'connect',
  253.              'ppdfile', 'dd', 'att', 'delay')) {
  254.         if (!defined($config->{$i})) {
  255.             if ($olddatablob->{'queuedata'}{$i}){
  256.             $config->{$i} = $olddatablob->{'queuedata'}{$i};
  257.             } elsif ($i eq 'dd') {
  258.             $config->{$i} = 0;
  259.             } elsif ($i eq 'att') {
  260.             $config->{$i} = 1;
  261.             } elsif ($i eq 'delay') {
  262.             $config->{$i} = 30;
  263.             } else {
  264.             $config->{$i} = "";
  265.             }
  266.         }
  267.         }
  268.         # Check consistency of the printer/driver settings
  269.         if ((($config->{'driver'} eq "") || 
  270.          ($config->{'driver'} eq "raw") || # No new driver, printer,
  271.          ($config->{'printer'} eq "")) &&  # PPD file
  272.         ($config->{'ppdfile'} eq "") &&
  273.         ((!defined($olddatablob->{'args'})) || # No existing options
  274.          ($#{$olddatablob->{'args'}} < 0))) {  # -> source queue raw
  275.         $config->{'driver'} = "raw";
  276.         $config->{'printer'} = undef;
  277.         }
  278.         # We do not need the queue data block any more
  279.         delete($olddatablob->{'queuedata'});
  280.     } else {
  281.         # No Foomatic/PPD data
  282.         $olddatablob = undef;
  283.     }
  284.     } else {
  285.     # Load the datablob of the former configuration
  286.     if ($reconf) {
  287.         if ($olddatablob = load_datablob($config->{'spooler'}, 
  288.                          $config->{'queue'})) {
  289.         # If the user has supplied only a printer or only a driver
  290.         # fill in the second of the two fields in $config
  291.         if ((!$config->{'ppdfile'}) &&
  292.             ($olddatablob->{'queuedata'}{'foomatic'})) {
  293.             if ((!$config->{'driver'}) && ($config->{'printer'})) {
  294.             $config->{'driver'} = $olddatablob->{'driver'};
  295.             }
  296.             if ((!$config->{'printer'}) && ($config->{'driver'})) {
  297.             $config->{'printer'} = $olddatablob->{'id'};
  298.             }
  299.         }
  300.         # Extract URI and backend error handling data
  301.         if ($config->{'spooler'} eq "cups") {
  302.             $beh->{'uri'} = $olddatablob->{'queuedata'}{'connect'};
  303.             $beh->{'dd'} = $olddatablob->{'queuedata'}{'dd'};
  304.             $beh->{'att'} = $olddatablob->{'queuedata'}{'att'};
  305.             $beh->{'delay'} = $olddatablob->{'queuedata'}{'delay'};
  306.         }
  307.         # We do not need the queue data block here
  308.         delete($olddatablob->{'queuedata'});
  309.         } else {
  310.         $olddatablob = undef;
  311.         }
  312.     }
  313.     }
  314.     
  315.     # If the user does not supply info about his printer and/or driver
  316.     # and the queue did not exist before we assume that he wants to set up a
  317.     # raw queue. To make a raw queue out of a formerly filtered one, one
  318.     # has to use the driver name "raw".
  319.     $config->{'driver'} = "" if not defined $config->{'driver'};
  320.     $config->{'printer'} = "" if not defined $config->{'printer'};
  321.     $config->{'ppdfile'} = "" if not defined $config->{'ppdfile'};
  322.     my $nodriver = (((!$config->{'driver'}) && (!$config->{'printer'}) &&
  323.              (!$config->{'ppdfile'})) ||
  324.             ($config->{'driver'} eq "raw"));
  325.  
  326.     # Set to 1 when we retrieve a data set from the Foomatic database
  327.     my $newfoomaticdata = 0;
  328.     if ($nodriver) {
  329.     if ($olddatablob) {
  330.         if ($config->{'driver'} ne "raw") {
  331.         # We couldn't determine a certain driver, probably we had a
  332.         # native PostScript PPD file
  333.         $db->{'dat'} = $olddatablob;
  334.         } else {
  335.         # For a raw queue overtake at least the $postpipe
  336.         if (defined($olddatablob->{'postpipe'})) {
  337.             $db->{'dat'}{'postpipe'} = $olddatablob->{'postpipe'};
  338.         }
  339.         }
  340.     }
  341.     } elsif ($config->{'ppdfile'}) {
  342.     if (! -r $config->{'ppdfile'}) {
  343.         die "The PPD file \'$config->{'ppdfile'}\' does not exist or is " .
  344.         "readable.\n";
  345.     }
  346.     # Load the data from the PPD file
  347.     $db->getdatfromppd($config->{'ppdfile'});
  348.     # Overtake the former default settings
  349.     if ($olddatablob) {overtake_defaults($olddatablob)};
  350.     # Overtake the former $postpipe
  351.     if (defined($olddatablob->{'postpipe'})) {
  352.         $db->{'dat'}{'postpipe'} = $olddatablob->{'postpipe'};
  353.     }
  354.     } else {
  355.     if (($olddatablob) &&
  356.         ($olddatablob->{'driver'} eq $config->{'driver'}) &&
  357.         ($olddatablob->{'id'} eq $config->{'printer'}) &&
  358.         (!$config->{'force'})) {
  359.         # Overtake data from the former configuration
  360.         $db->{'dat'} = $olddatablob;
  361.     } else {
  362.         # Retrieve data from the Foomatic database
  363.         if (!$config->{'driver'}) {
  364.         die "You also need to specify a driver with \"-d\"!\n";
  365.         }
  366.         if (!$config->{'printer'}) {
  367.         die "You also need to specify a printer with \"-p\"!\n";
  368.         }
  369.         # The printer is supported by the chosen driver? If yes, load
  370.         # its data
  371.         my $possible = $db->getdat($config->{'driver'}, 
  372.                        $config->{'printer'});
  373.         die "That printer and driver combination is not possible.\n"
  374.         if (!$possible);
  375.         die "There is neither a custom PPD file nor the driver database entry contains sufficient data to build a PPD file.\n"
  376.         if (!$db->{'dat'}{'cmd'}) && (!$db->{'dat'}{'ppdfile'});
  377.         $newfoomaticdata = 1;
  378.         # Overtake the former default settings
  379.         if ($olddatablob) {overtake_defaults($olddatablob)};
  380.         # Overtake the former $postpipe
  381.         if (defined($olddatablob->{'postpipe'})) {
  382.         $db->{'dat'}{'postpipe'} = $olddatablob->{'postpipe'};
  383.         }
  384.     }
  385.     }
  386.  
  387.     # When we have no arguments in the current configuration, we must have 
  388.     # a raw queue
  389.     my $rawqueue = ((!defined($db->{'dat'}{'args'})) ||
  390.              ($#{$db->{'dat'}{'args'}} < 0));
  391.  
  392.     # Set the default printing options supplied on the command line
  393.     if (!$rawqueue) {
  394.     set_default_options($config, $db->{'dat'});
  395.     }
  396.  
  397.     # Printer model name (for comment field of the queue configuration)
  398.     my ($make, $model, $makemodel);
  399.     if (defined($db->{'dat'})) {
  400.     $make = $db->{'dat'}{'make'};
  401.     $model = $db->{'dat'}{'model'};
  402.     $makemodel = $db->{'dat'}{'makemodel'};
  403.     if (($make) && ($model)) { 
  404.         $makemodel = "$make $model";
  405.     }
  406.     }
  407.  
  408.     return ($rawqueue, $newfoomaticdata, $makemodel,
  409.         ($config->{'spooler'} eq "cups" ? $beh : ()));
  410. }
  411.  
  412. #fix to work on Ubuntu, where cupd runs not as root, but as cupsys user
  413. #like system ("chown cupsys $ppdfile"), but
  414. #changeowner function changes owner only if user exists on system
  415. sub changeowner {
  416.  
  417.     my ($username, $file) = @_;
  418.  
  419.     my ($uid,$gid) = (-1, -1);
  420.     my $l;
  421.     $l = getpwnam($username); $uid = $l if defined($l);
  422.     $l = getgrnam($username); $gid = $l if defined($l);
  423.     chown $uid, $gid, $file;
  424.  
  425. }
  426.  
  427. sub writeppdfile {
  428.  
  429.     my ($config, $ppdfile, $rawqueue, $newfoomaticdata) = @_;
  430.  
  431.     # Save old $ppdfile, if any
  432.     system("cp -f \'$ppdfile\' \'$ppdfile.old\'") 
  433.     if (-f $ppdfile);
  434.     if ($rawqueue) {
  435.     # Raw queue with $postpipe, use a "PPD" only containing the
  436.     # $postpipe (LPRng, LPD, and no spooler only)
  437.     if (((defined $db->{'dat'}{'postpipe'} && $db->{'dat'}{'postpipe'} ne "") &&
  438.          (($config->{'spooler'} eq 'lprng') ||
  439.           ($config->{'spooler'} eq 'lpd'))) ||
  440.         ($config->{'spooler'} eq 'direct')) {
  441.         open PPDFILE, "> $ppdfile" or die "Cannot write \'$ppdfile\'!\n";
  442.         print PPDFILE "*PPD-Adobe: \"4.3\"\n*%\n";
  443.         print PPDFILE "*% This is a raw (driverless/unfiltered) " .
  444.         "queue, this PPD file only carries\n" .
  445.         "*% the postpipe.\n*%\n";
  446.         close PPDFILE;
  447.         $db->ppdsetdefaults($ppdfile);
  448.         chmod 0644, $ppdfile;
  449.             #fix to work on Ubuntu, where cupd runs not as root, but as cupsys user
  450.             #system ("chown cupsys $ppdfile");
  451.         #changeowner function changes owner only if user exists on system
  452.         changeowner("cupsys", $ppdfile);
  453.     } else {
  454.         if (-f $ppdfile) {
  455.         unlink "$ppdfile" or die "Cannot delete \'$ppdfile\'!\n";
  456.         }
  457.     }
  458.     } else {
  459.     if ($config->{'ppdfile'}) {
  460.         # Copy in the PPD file specified on the command line
  461.         if ($config->{'ppdfile'} !~ /\.gz$/i) {
  462.         # Uncompressed PPD file
  463.         system("cp -f \'$config->{'ppdfile'}\' \'$ppdfile\'") and
  464.             die "Cannot copy \'$config->{'ppdfile'}\' to \'$ppdfile\'!\n";
  465.         } else {
  466.         # Compressed PPD file
  467.         system("$sysdeps->{'gzip'} -dc " .
  468.                "\'$config->{'ppdfile'}\' > " .
  469.                "\'$ppdfile\'") and
  470.             die "Cannot copy \'$config->{'ppdfile'}\' to \'$ppdfile\'!\n";
  471.         }
  472.         # Set default option settings and $postpipe
  473.         $db->ppdsetdefaults($ppdfile);
  474.     } elsif ($newfoomaticdata) {
  475.         # Generate the PPD file from the Foomatic database
  476.         open PPDFILE, "> $ppdfile" or die "Cannot write \'$ppdfile\'!\n";
  477.         print PPDFILE $db->getppd($config->{'shortgui'});
  478.         close PPDFILE;
  479.     } else {
  480.         # Keep the previous PPD file, only set the options and the
  481.         # $postpipe
  482.         $db->ppdsetdefaults($ppdfile);
  483.     }
  484.     # Correct the permissions of the PPD file
  485.     chmod 0644, $ppdfile;
  486.     #fix to work on Ubuntu, where cupd runs not as root, but as cupsys user
  487.     #system ("chown cupsys $ppdfile");
  488.     #changeowner function changes owner only if user exists on system
  489.     changeowner("cupsys", $ppdfile);
  490.     }
  491. }
  492.  
  493.  
  494. ### Queue manipulation functions for both LPD and LPRng
  495.  
  496. sub setup_lpd {
  497.     my ($config) = $_[0];
  498.  
  499.     # Read the previous /etc/printcap
  500.     my $pcap = load_lpd_printcap();
  501.  
  502.     my ($ppdfile, $entry, $reconf, $p);
  503.     for $p (@{$pcap}) {
  504.     if ($p->{'names'}[0] eq $config->{'queue'}) {
  505.         $entry = $p;
  506.         $reconf = 1;
  507.         print "Reconfigure of ", Dumper($p) if $debug;
  508.         last;
  509.     }
  510.     }
  511.  
  512.     # PPD file name
  513.     $ppdfile = sprintf('%s/lpd/%s.ppd',
  514.                   $sysdeps->{'foo-etc'},
  515.                   $config->{'queue'}) if !$ppdfile;
  516.  
  517.     # Get the data from the former queue if we reconfigure or copy a queue
  518.     # do also some checking of the user-supplied parameters
  519.     my ($rawqueue, $newfoomaticdata, $makemodel) =
  520.     getoldqueuedata($config, $reconf);
  521.  
  522.     # Set the printer queue name line in /etc/printcap
  523.     if (!$reconf) {
  524.     if (!$rawqueue) {
  525.         $entry->{'names'}[0] = $config->{'queue'}; 
  526.         $entry->{'names'}[1] = $config->{'desc'};
  527.         $entry->{'names'}[2] = "$makemodel";
  528.         $entry->{'names'}[3] = $config->{'loc'};
  529.     } else {
  530.         $entry->{'names'}[0] = $config->{'queue'}; 
  531.         $entry->{'names'}[1] = $config->{'desc'};
  532.         $entry->{'names'}[2] = "Raw queue";
  533.         $entry->{'names'}[3] = $config->{'loc'};
  534.     }
  535.     } else {
  536.     if (!$rawqueue) {
  537.         $entry->{'names'}[2] = "$makemodel";
  538.     } else {
  539.         if (($entry->{'names'}[2] eq "Raw queue") ||
  540.         ($config->{'driver'} eq "raw")) {
  541.         $rawqueue = 1;
  542.         $entry->{'names'}[2] = "Raw queue";
  543.         }
  544.     }
  545.     if (defined($config->{'desc'})) {
  546.         $entry->{'names'}[1] = $config->{'desc'};
  547.     }
  548.     if (defined($config->{'loc'})) {
  549.         $entry->{'names'}[3] = $config->{'loc'};
  550.     }
  551.     }
  552.  
  553.     # These lines are always in /etc/printcap
  554.     $entry->{'str'}{'sd'} = sprintf('%s/%s',
  555.                     $sysdeps->{'lpd-dir'},
  556.                     $config->{'queue'});
  557.     $entry->{'str'}{'lf'} = $sysdeps->{'lpd-log'};
  558.     $entry->{'num'}{'mx'} = '0';
  559.     $entry->{'bool'}{'sh'} = 1;
  560.  
  561.     # Lines depending on the printer/spooler
  562.     if (!$rawqueue) {
  563.     if ($config->{'spooler'} eq "lpd") {
  564.         $entry->{'str'}{'ppdfile'} = $ppdfile; # For the GPR printing GUI
  565.         delete $entry->{'str'}{'ppd'};
  566.         $entry->{'str'}{'if'} = $sysdeps->{'foomatic-rip'};
  567.         $entry->{'str'}{'af'} = $ppdfile;
  568.         delete $entry->{'bool'}{'force_localhost'};
  569.         delete $entry->{'str'}{'filter_options'};
  570.     } elsif ($config->{'spooler'} eq "lprng") {
  571.         $entry->{'str'}{'ppd'} = $ppdfile; # for LPRng PPD support
  572.         $entry->{'str'}{'if'} = $sysdeps->{'foomatic-rip'};
  573.         $entry->{'bool'}{'force_localhost'} = 1;
  574.         delete $entry->{'str'}{'ppdfile'};
  575.         delete $entry->{'str'}{'af'};
  576.         delete $entry->{'str'}{'filter_options'};
  577.     } else {
  578.         die "The spooler $config->{'spooler'} is not supported " .
  579.         "by this function!\n";
  580.     }
  581.     } else {
  582.     delete $entry->{'str'}{'if'};
  583.     delete $entry->{'str'}{'af'};
  584.     delete $entry->{'str'}{'filter_options'};
  585.     delete $entry->{'str'}{'ppd'};
  586.     if ($config->{'spooler'} eq "lpd") {
  587.         delete $entry->{'bool'}{'force_localhost'};
  588.     } elsif ($config->{'spooler'} eq "lprng") {
  589.         $entry->{'bool'}{'force_localhost'} = 1;
  590.     } else {
  591.         die "The spooler $config->{'spooler'} is not supported " .
  592.         "by this function!\n";
  593.     }
  594.     }
  595.  
  596.     # If printing job has to be passed through a special program, put the
  597.     # command line into $postpipe (for example for Socket, Samba, ...)
  598.     my $postpipe = "";
  599.  
  600.     if ((!$reconf) or ($config->{'connect'})) {
  601.     # Set up connection type
  602.  
  603.     # Remove "rm" and "rp" tags to avoid problems when overwriting a
  604.     # raw queue
  605.     delete $entry->{'str'}{'rm'};
  606.     delete $entry->{'str'}{'rp'};
  607.  
  608.     # All URIs ("-c" option) have the same syntax as URIs in CUPS ("-v"
  609.     # option of "lpadmin").
  610.     my $file;
  611.     if ($config->{'connect'} =~ m!^(file|usb|parallel|serial):(.*)!) {
  612.         # Local printer or printing to a file
  613.         $file = $2;
  614.         if ($config->{'connect'} =~ m!^usb://!) {
  615.         # Queue with printer-bound USB URI transferred from CUPS,
  616.         # as LPD/LPRng does not support these URIs, translate it
  617.         # back to a standard USB device URI
  618.         $file = cups_usb_printer_uri_to_device_uri($file);
  619.         }
  620.         if (! -e $file) {
  621.         warn "The device or file $file doesn't exist? " .
  622.             "Working anyway.\n";
  623.         }
  624.         if (($file =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) ||
  625.         ($file =~ m!^/dev/ptal-printd/(.+)$!) ||
  626.         ($file =~ m!^/var/run/ptal-printd/(.+)$!)) {
  627.         # Translate URI for ptal-printd to postpipe using the
  628.         # "ptal-connect" command
  629.         my $devname = $1;
  630.         $devname =~ s/_/:/;
  631.         $devname =~ s/_/:/;
  632.         $postpipe = "$sysdeps->{'ptal-connect'} $devname -print";
  633.         $entry->{'str'}{'lp'} = "/dev/null";
  634.         } else {
  635.         $entry->{'str'}{'lp'} = $file;
  636.         }
  637.     } elsif ($config->{'connect'} =~ m!^ptal://?([^/].*)$!) {
  638.         # HPOJ MLC protocol
  639.         my $devname = $1;
  640.         $postpipe = "$sysdeps->{'ptal-connect'} $devname -print";
  641.         $entry->{'str'}{'lp'} = "/dev/null";
  642.     } elsif ($config->{'connect'} =~ m!^mtink:/(.+)$!) {
  643.         # Printing through "mtinkd"
  644.         $entry->{'str'}{'lp'} = "$sysdeps->{'mtink-pipes'}/$1";
  645.     } elsif ($config->{'connect'} =~ m!^lpd://([^/]+)/([^/]+)$!) {
  646.         # Remote LPD
  647.         my $remhost = $1;
  648.         my $remqueue = $2;
  649.         if (($rawqueue) && ($config->{'spooler'} eq "lpd")) {
  650.         $entry->{'str'}{'rm'} = $remhost;
  651.         $entry->{'str'}{'rp'} = $remqueue;
  652.         delete $entry->{'str'}{'lp'};
  653.         } elsif( ($config->{'spooler'} eq "lprng")) {
  654.         delete $entry->{'str'}{'rm'};
  655.         delete $entry->{'str'}{'rp'};
  656.         $entry->{'str'}{'lp'} = "$remqueue\@$remhost";
  657.         } else {
  658.         # classic LPD does not support sending jobs to a server with the
  659.         # "rm" and "rp" tags in /etc/printcap and filtering it
  660.         # before ("if" tag). So when we do not set up a raw queue,
  661.         # we do not
  662.         #
  663.         #   $entry->{'str'}{'rm'} = $remhost;
  664.         #   $entry->{'str'}{'rp'} = $remqueue;
  665.         #
  666.         # but use "rlpr" in a $postpipe. Note that "rlpr" prints a
  667.         # banner page by default, "-h" suppresses it. "rlpr" must
  668.         # be SUID "root".
  669.         $postpipe = "$sysdeps->{'rlpr'} -q -h -P " .
  670.             "$remqueue\@$remhost";
  671.         $entry->{'str'}{'lp'} = "/dev/null";
  672.         }
  673.     } elsif ($config->{'connect'} =~
  674.          m!^socket://([^/:]+):([0-9]+)/?$!) {
  675.         # Socket (AppSocket/HP JetDirect)
  676.         my $remhost = $1;
  677.         my $remport = $2;
  678.         if( ($config->{'spooler'} eq "lprng")) {
  679.         $entry->{'str'}{'lp'} = "$remhost\%$remport";
  680.         } else {
  681.         $postpipe = "$sysdeps->{'nc'} -w 1 $remhost $remport";
  682.         $entry->{'str'}{'lp'} = "/dev/null";
  683.         }
  684.     } elsif ($config->{'connect'} =~ m!^smb://(.*)$!) {
  685.         # SMB (Printer on Windows server)
  686.         my $parameters = $1;
  687.         # Get the user's login and password from the URI
  688.         my $smbuser = "";
  689.         my $smbpassword = "";
  690.         if ($parameters =~ m!([^@]*)@([^@]+)!) {
  691.         my $login = $1;
  692.         $parameters = $2;
  693.         if ($login =~ m!([^:]*):([^:]*)!) {
  694.             $smbuser = $1;
  695.             $smbpassword = $2;
  696.         } else {
  697.             $smbuser = $login;
  698.             $smbpassword = "";
  699.         }
  700.         } else {
  701.         $smbuser = "GUEST";
  702.         $smbpassword = "";
  703.         }
  704.         # Get the workgroup, server, and share name
  705.         my $workgroup = "";
  706.         my $smbserver = "";
  707.         my $smbshare = "";
  708.         if ($parameters =~ m!([^/]*)/([^/]+)/([^/]+)$!) {
  709.         $workgroup = $1;
  710.         $smbserver = $2;
  711.         $smbshare = $3;
  712.         } elsif ($parameters =~ m!([^/]+)/([^/]+)$!) {
  713.         $workgroup = "";
  714.         $smbserver = $1;
  715.         $smbshare = $2;
  716.         } else {
  717.         die "The \"smb://\" URI must at least contain the " .
  718.             "server name and the share name!\n";
  719.         }
  720.         # Set up the command line for printing on the SMB server
  721.         $postpipe = "$sysdeps->{'smbclient'} '//$smbserver/$smbshare'";
  722.         if ($smbpassword ne "") {
  723.         warn("WARNING: smbclient password is visible in PPD file\n");
  724.         $postpipe .= " '$smbpassword'";
  725.         }
  726.         if ($smbuser ne "") {$postpipe .= " -U '$smbuser'";}
  727.         if ($workgroup ne "") {$postpipe .= " -W '$workgroup'";}
  728.         $postpipe .= " -N -P -c 'print -' ";
  729.         $entry->{'str'}{'lp'} = "/dev/null";
  730.     } elsif ($config->{'connect'} =~ m!^ncp://(.*)$!) {
  731.         my $parameters = $1;
  732.         # Get the user's login and password from the URI
  733.         my $ncpuser = "";
  734.         my $ncppassword = "";
  735.         if ($parameters =~ m!([^@]*)@([^@]+)!) {
  736.         my $login = $1;
  737.         $parameters = $2;
  738.         if ($login =~ m!([^:]*):([^:]*)!) {
  739.             $ncpuser = $1;
  740.             $ncppassword = $2;
  741.         } else {
  742.             $ncpuser = $login;
  743.             $ncppassword = "";
  744.         }
  745.         } else {
  746.         $ncpuser = "";
  747.         $ncppassword = "";
  748.         }
  749.         # Get the server and share name
  750.         my $ncpserver = "";
  751.         my $ncpqueue = "";
  752.         if ($parameters =~ m!([^/]+)/([^/]+)$!) {
  753.         $ncpserver = $1;
  754.         $ncpqueue = $2;
  755.         } else {
  756.         die "The \"ncp://\" URI must at least contain the " .
  757.             "server name and the queue name!\n";
  758.         }
  759.         # Set up the command line for printing on the Netware server
  760.         $postpipe = "$sysdeps->{'nprint'} -S $ncpserver";
  761.         if ($ncpuser ne "") {
  762.         $postpipe .= " -U $ncpuser";
  763.         if ($ncppassword ne "") {
  764.             warn("WARNING: ncp password is visible in PPD file\n");
  765.             $postpipe .= " -P $ncppassword";
  766.         } else {
  767.             $postpipe .= " -n";
  768.         }
  769.         }
  770.         $postpipe .= " -q $ncpqueue -N - 2>/dev/null";
  771.         $entry->{'str'}{'lp'} = "/dev/null";
  772.     } elsif ($config->{'connect'} =~ m!^postpipe:(.*)$!) {
  773.         # Pipe output into a command
  774.         $postpipe = $1;
  775.         $entry->{'str'}{'lp'} = "/dev/null";
  776.     } elsif ($config->{'connect'}) {
  777.         $entry->{'str'}{'lp'} = '/dev/null';
  778.         die ("The URI \"$config->{'connect'}\" is not supported " .
  779.          "for LPD/LPRng or you have\nmistyped.\n");
  780.     } else {
  781.         print STDERR "You must specify a connection with -c.\n";
  782.         help();
  783.         exit(1);
  784.     }
  785.     # Put $postpipe into the data structure, so that it will be
  786.     # inserted into the PPD file
  787.     if ($postpipe ne "") {
  788.         $postpipe = "| $postpipe";
  789.         $db->{'dat'}{'postpipe'} = $postpipe;
  790.     } else {
  791.         undef $db->{'dat'}{'postpipe'};
  792.     }
  793.     } else {
  794.     # Keep previous connection type
  795.     # Use previous $postpipe
  796.     if (defined($db->{'dat'}{'postpipe'})) {
  797.         $postpipe = $db->{'dat'}{'postpipe'};
  798.     }
  799.     }
  800.  
  801.     # When we have a $postpipe we never write to a device
  802.     if ($postpipe ne "") {
  803.     $entry->{'str'}{'lp'} = '/dev/null';
  804.     if ($config->{'spooler'} eq "lpd") {
  805.         $entry->{'str'}{'if'} = $sysdeps->{'foomatic-rip'};
  806.         $entry->{'str'}{'af'} = $ppdfile;
  807.     } elsif ($config->{'spooler'} eq "lprng") {
  808.         $entry->{'str'}{'if'} = $sysdeps->{'foomatic-rip'};
  809.         $entry->{'str'}{'ppd'} = $ppdfile;
  810.         $entry->{'bool'}{'force_localhost'} = 1;
  811.     } else {
  812.         die "The spooler $config->{'spooler'} is not supported " .
  813.         "by this function!\n";
  814.     }
  815.     }
  816.  
  817.     # Various file setup
  818.     mkdir $sysdeps->{'foo-etc'}, 0755;
  819.     mkdir "$sysdeps->{'foo-etc'}/lpd", 0755;
  820.     mkdir $entry->{'str'}{'sd'}, 0755;
  821.  
  822.     # Lead with a blank line for new entries
  823.     push (@{$entry->{'comments'}}, "\n")
  824.     if (!$reconf);
  825.  
  826.     # Put in a useful comment for both new and old entries
  827.     push (@{$entry->{'comments'}},
  828.       sprintf ("\# Entry edited %s by $progname.",
  829.            scalar(localtime(time))),
  830.       "\# Additional configuration atop $ppdfile");
  831.  
  832.     # Add to the printcap if a new entry
  833.     if (!$reconf) {
  834.     push(@{$pcap}, $entry);
  835.     }
  836.  
  837.     # Generate/write te PPD file
  838.     writeppdfile($config, $ppdfile, $rawqueue, $newfoomaticdata);
  839.  
  840.     # Make sure that /var/spool/lp-errs exists
  841.     system "touch $sysdeps->{'lpd-log'}";
  842.     chmod 0600, $sysdeps->{'lpd-log'};
  843.     my ($lpuid, $lpgid) = (-1, -1);
  844.     my $l;
  845.     $l = getpwnam("lp"); $lpuid = $l if defined($l);
  846.     $l = getgrnam("lp"); $lpgid = $l if defined($l);
  847.     chown $lpuid, $lpgid, $sysdeps->{'lpd-log'};
  848.  
  849.     # Write back /etc/printcap
  850.     my $printcap = $sysdeps->{'lpd-pcap'};
  851.     rename $printcap, "$printcap.old" or die "Cannot backup $printcap!\n";
  852.     open PRINTCAP, "> $printcap" or die "Cannot write $printcap!\n";
  853.     print PRINTCAP dump_lpd_printcap($config, $pcap);
  854.     close PRINTCAP;
  855.     chmod 0644, $printcap;
  856.  
  857.     # In case of LPRng, give SIGHUP to the daemon, LPRng needs this to 
  858.     # recognize a new queue
  859.     if ($config->{'spooler'} eq "lprng") {
  860.     # first check configuration
  861.     system("$sysdeps->{'lprng-checkpc'} -f > /dev/null 2>&1");
  862.     # now signal to use it
  863.     system("$sysdeps->{'lpd-lpc'} reread > /dev/null 2>&1");
  864.     }
  865.  
  866.     return 1;
  867. }
  868.  
  869. sub default_lpd {
  870.     my ($config) = $_[0];
  871.  
  872.     my $name = $config->{'queue'};
  873.  
  874.     my $pcap = load_lpd_printcap();
  875.  
  876.     # Add the alias "lp" to the /etc/printcap entry to make LPD considering
  877.     # the chosen printer as default printer
  878.  
  879.     # Some stuff for renaming a queue named "lp"
  880.     my $nppdfile = undef;
  881.     my $newname = undef;
  882.     my $rawqueue = 0;
  883.  
  884.     my @newcap;
  885.     for (@{$pcap}) {
  886.     my $p = $_;
  887.     if ($p->{'names'}[0] eq $name) {
  888.         $p->{'names'}[4] = 'lp';
  889.     } else {
  890.         # Rename a printer whose first name is 'lp'
  891.         if ($p->{'names'}[0] eq 'lp') {
  892.         # Do we have a raw queue?
  893.         if ((!defined($p->{'str'}{'if'})) ||
  894.             ($p->{'str'}{'if'} ne $sysdeps->{'foomatic-rip'})) {
  895.             $rawqueue = 1;
  896.         }
  897.         # Search for a free name
  898.         my $i = 0;
  899.         my $namefound = 0;
  900.         while(!$namefound) {
  901.             my $pp;
  902.             my $nameinuse = 0;
  903.             for $pp (@{$pcap}) {
  904.             if (defined($pp->{'names'})) {
  905.                 my $n;
  906.                 for $n (@{$pp->{'names'}}) {
  907.                 if ($n eq "lp$i") {
  908.                     $nameinuse = 1;
  909.                     last;
  910.                 }
  911.                 }
  912.                 if ($nameinuse) {
  913.                 $i++;
  914.                 last;
  915.                 }
  916.             }
  917.             }
  918.             $namefound = 1 - $nameinuse;
  919.         }
  920.         $newname = "lp$i";
  921.  
  922.         # Old PPD file name
  923.         my $ppdfile = sprintf('%s/lpd/lp.ppd',
  924.                    $sysdeps->{'foo-etc'});
  925.         
  926.         # New PPD file name
  927.         my $nppdfile = sprintf('%s/lpd/%s.ppd',
  928.                     $sysdeps->{'foo-etc'},
  929.                     $newname);
  930.         
  931.         # Rename the printer
  932.         $p->{'names'}[0] = $newname;
  933.         my $oldspooldir = $p->{'str'}{'sd'};
  934.         $p->{'str'}{'sd'} = sprintf('%s/%s',
  935.                         $sysdeps->{'lpd-dir'},
  936.                         $newname);
  937.         if ($p->{'str'}{'af'} =~ /\.ppd$/) {
  938.             $p->{'str'}{'af'} = $nppdfile;
  939.         }
  940.  
  941.         # Rename old $ppdfile, if any
  942.         rename $ppdfile, $nppdfile
  943.             if (-f $ppdfile);
  944.         
  945.         # Rename the spool directory
  946.         rename $oldspooldir, $p->{'str'}{'sd'}
  947.             if (-d $oldspooldir);
  948.  
  949.         # Put out warning
  950.         warn("WARNING: Printer \"lp\" renamed to \"$newname\".\n");
  951.         }
  952.         # Remove 'lp' as alias name
  953.         my $n;
  954.         for $n (@{$p->{'names'}}) {
  955.         if ($n eq 'lp') {
  956.             $n = '';
  957.         }
  958.         }
  959.     }
  960.     push (@newcap, $p);
  961.     }
  962.  
  963.     my @newprintcap = dump_lpd_printcap($config, \@newcap);
  964.  
  965.     my $printcap = $sysdeps->{'lpd-pcap'};
  966.     rename $printcap, "$printcap.old" or die "Cannot backup $printcap!\n";
  967.     open PRINTCAP, "> $printcap" or die "Cannot write $printcap!\n";
  968.     print PRINTCAP @newprintcap;
  969.     close PRINTCAP;
  970.     chmod 0644, $printcap;
  971.  
  972.     return 1;
  973. }
  974.  
  975. sub default_lprng {
  976.     my ($config) = $_[0];
  977.  
  978.     my $name = $config->{'queue'};
  979.  
  980.     my $pcap = load_lpd_printcap();
  981.  
  982.     # Move the /etc/printcap entry for the chosen printer to the first place
  983.     # so that LPRng considers it as the default printer
  984.  
  985.     my @newcap;
  986.     for (@{$pcap}) {
  987.     push (@newcap, $_)
  988.         if ($_->{'names'}[0] eq $name);
  989.     }
  990.     for (@{$pcap}) {
  991.     push (@newcap, $_)
  992.         unless ($_->{'names'}[0] eq $name);
  993.     }
  994.  
  995.     my @newprintcap = dump_lpd_printcap($config, \@newcap);
  996.  
  997.     my $printcap = $sysdeps->{'lpd-pcap'};
  998.     rename $printcap, "$printcap.old" or die "Cannot backup $printcap!\n";
  999.     open PRINTCAP, "> $printcap" or die "Cannot write $printcap!\n";
  1000.     print PRINTCAP @newprintcap;
  1001.     close PRINTCAP;
  1002.     chmod 0644, $printcap;
  1003.  
  1004.     # In case of LPRng, give SIGHUP to the daemon, LPRng needs this to 
  1005.     # recognize the changes
  1006.     if ($config->{'spooler'} eq "lprng") {
  1007.     system("$sysdeps->{'lpd-lpc'} reread > /dev/null 2>&1");
  1008.     system("$sysdeps->{'lprng-checkpc'} -f > /dev/null 2>&1");
  1009.     }
  1010.  
  1011.     return 1;
  1012. }
  1013.  
  1014. sub delete_lpd {
  1015.     my ($config) = $_[0];
  1016.  
  1017.     my $name = $config->{'queue'};
  1018.  
  1019.     my $pcap = load_lpd_printcap();
  1020.  
  1021.     my @newcap;
  1022.     for (@{$pcap}) {
  1023.     push (@newcap, $_)
  1024.         unless ($_->{'names'}[0] eq $name);
  1025.     }
  1026.  
  1027.     my @newprintcap = dump_lpd_printcap($config, \@newcap);
  1028.  
  1029.     my $printcap = $sysdeps->{'lpd-pcap'};
  1030.     rename $printcap, "$printcap.old" or die "Cannot backup $printcap!\n";
  1031.     open PRINTCAP, "> $printcap" or die "Cannot write $printcap!\n";
  1032.     print PRINTCAP @newprintcap;
  1033.     close PRINTCAP;
  1034.     chmod 0644, $printcap;
  1035.  
  1036.     # PPD file name
  1037.     my $ppdfile = sprintf('%s/lpd/%s.ppd',
  1038.               $sysdeps->{'foo-etc'},
  1039.               $config->{'queue'});
  1040.  
  1041.     # Rename old $ppdfile, if any
  1042.     rename $ppdfile, "$ppdfile.old" 
  1043.     if (-f $ppdfile);
  1044.  
  1045.     # In case of LPRng, give SIGHUP to the daemon, LPRng needs this to 
  1046.     # recognize the changes
  1047.     if ($config->{'spooler'} eq "lprng") {
  1048.     system("$sysdeps->{'lpd-lpc'} reread > /dev/null 2>&1");
  1049.     system("$sysdeps->{'lprng-checkpc'} -f > /dev/null 2>&1");
  1050.     }
  1051.  
  1052.     return 1;
  1053. }
  1054.  
  1055. sub query_lpd {
  1056.     my ($config) = @_;
  1057.  
  1058.     # User requests data of a printer/driver combo to see the options before
  1059.     # installing a queue
  1060.     if (($opt_P) && ((($config->{'driver'}) && ($config->{'printer'}) &&
  1061.     ($config->{'driver'} ne "raw")) || ($config->{'ppdfile'}))) {
  1062.     if ($opt_n) {
  1063.         my $olddatablob = load_lpd_datablob($opt_n);
  1064.         print_perl_combo_data($config, $olddatablob);
  1065.     } else {
  1066.         print_perl_combo_data($config);
  1067.     }
  1068.     return;
  1069.     }
  1070.  
  1071.     my $i = $ARGV[0];
  1072.     if (!defined($i)) {$i = 0;}
  1073.  
  1074.     my $pcap = load_lpd_printcap();
  1075.     my $p;
  1076.  
  1077.     if (!$opt_P) {
  1078.     print "<queues>\n";
  1079.     }
  1080.  
  1081.     # Query the default printer
  1082.     my $default;
  1083.     if (!defined($config->{'queue'})) {
  1084.     if ($config->{'spooler'} eq "lpd") {
  1085.         # Under LPD the default printer is the printer which has
  1086.         # "lp" as its name or as an alias name
  1087.         my $def_firstname = undef;
  1088.         for $p (@{$pcap}) {
  1089.         if (defined($p->{'names'})) {
  1090.             my $n;
  1091.             for $n (@{$p->{'names'}}) {
  1092.             if ($n eq 'lp') {
  1093.                 $def_firstname = $p->{'names'}[0];
  1094.                 last;
  1095.             }
  1096.             }
  1097.             if (defined($def_firstname)) {
  1098.             last;
  1099.             }
  1100.         }
  1101.         }
  1102.         if (defined($def_firstname)) {
  1103.         $default = $def_firstname;
  1104.         if (!$opt_P) {
  1105.             print "<defaultqueue>$def_firstname</defaultqueue>\n";
  1106.         }
  1107.         }
  1108.     } else {
  1109.         # Under LPRng the default printer is the first entry in
  1110.         # /etc/printcap
  1111.         for $p (@{$pcap}) {
  1112.         if (defined($p->{'names'})) {
  1113.             $default = $p->{'names'}[0];
  1114.             if (!$opt_P) {
  1115.             print "<defaultqueue>$p->{'names'}[0]" .
  1116.                 "</defaultqueue>\n";
  1117.             }
  1118.             last;
  1119.         }
  1120.         }
  1121.     }
  1122.     }
  1123.  
  1124.     for $p (@{$pcap}) {
  1125.     # enpty end entry for trailing comments
  1126.     next if !defined($p->{'names'});
  1127.     
  1128.     # were we invoked for only one queue?
  1129.     next if (defined($config->{'queue'})
  1130.          and $config->{'queue'} ne $p->{'names'}[0]);
  1131.  
  1132.     # load the queue data
  1133.     $db->{'dat'} = load_lpd_datablob($p->{'names'}[0]);
  1134.  
  1135.     # extract the queue data block
  1136.         my $c = $db->{'dat'}{'queuedata'};
  1137.  
  1138.     if ($opt_P) {
  1139.         if ($p->{'names'}[0] eq $default) {
  1140.         $db->{'dat'}{'queuedata'}{'default'} = 1;
  1141.         } else {
  1142.         $db->{'dat'}{'queuedata'}{'default'} = 0;
  1143.         }
  1144.         $db->{'dat'}{'queuedata'}{'remote'} = 0;
  1145.         my $asciidata = $db->getascii();
  1146.         $asciidata =~ s/\$VAR1/\$QUEUES[$i]/g;
  1147.         print $asciidata;
  1148.         $i ++;
  1149.     } else {
  1150.         # and get it to standard output
  1151.         dump_config($c);
  1152.     }
  1153.     }
  1154.  
  1155.     if (!$opt_P) {
  1156.     print "</queues>\n";
  1157.     }
  1158.  
  1159.     return;
  1160. }
  1161.  
  1162. ### Queue manipulation functions for CUPS
  1163.  
  1164. sub setup_cups {
  1165.     my ($config) = $_[0];
  1166.  
  1167.     # PPD file name
  1168.     # (/etc/foomatic/cups/ will be a link to /etc/cups/ppd/)
  1169.     my $ppdfile = sprintf('%s/ppd/%s.ppd',
  1170.                   $sysdeps->{'cups-etc'},
  1171.                   $config->{'queue'});
  1172.  
  1173.     # Get the data from the former queue if we reconfigure or copy a queue
  1174.     # do also some checking of the user-supplied parameters
  1175.     my ($rawqueue, $newfoomaticdata, $makemodel, $beh) =
  1176.     getoldqueuedata($config, 1);
  1177.  
  1178.     # Here we set up the command line for the "lpadmin" command
  1179.     my $lpadminline =
  1180.     "$sysdeps->{'cups-admin'} -p \"$config->{'queue'}\" -E";
  1181.  
  1182.     # Use manufacturer and model as description when no description is
  1183.     # provided
  1184.     if (defined($config->{'desc'})) {
  1185.     $lpadminline .= " -D \"$config->{'desc'}\"";
  1186.     } else {
  1187.     # Before we overwrite the description field with manufacturer
  1188.     # and model, check if there is some old contents
  1189.     my $pconf = load_cups_printersconf();
  1190.     my $p;
  1191.     my $olddesc;
  1192.     for $p (@{$pconf}) {
  1193.         next if (defined($config->{'queue'})
  1194.              and $config->{'queue'} ne $p->{'name'});
  1195.         $olddesc = $p->{'Info'};
  1196.     }
  1197.     if (!$olddesc) {
  1198.         if (!$rawqueue) {
  1199.         $lpadminline .= " -D \"$makemodel\"";
  1200.         } else {
  1201.         $lpadminline .= " -D \"Raw queue\"";
  1202.         }
  1203.     }
  1204.     }
  1205.  
  1206.     # Fill in the "location" field if something for it is provided.
  1207.     if (defined($config->{'loc'})) {
  1208.     $lpadminline .= " -L \"$config->{'loc'}\"";
  1209.     }
  1210.  
  1211.     # PPD file argument for the printer
  1212.     if (!$rawqueue) {
  1213.     $lpadminline .= " -P \'$ppdfile\'";
  1214.     }
  1215.  
  1216.     # All URIs ("-c" option) have the same syntax as URIs in CUPS
  1217.     # ("-v" option of "lpadmin"). Here the old "file:/" URIs are
  1218.     # translated to the form which CUPS needs. All other URIs are
  1219.     # simply passed to lpadmin.
  1220.  
  1221.     my $cupsuri = "";
  1222.     if (defined($config->{'connect'})) {
  1223.     if ($config->{'connect'} =~ m!^(file|usb|parallel|serial):(.*)$!) {
  1224.         # Translate "file:/" into the prefix needed by CUPS, if
  1225.         # necessary
  1226.         $cupsuri = $2;
  1227.         if ((($cupsuri =~ m!$sysdeps->{'ptal-pipes'}/(.+)$!) ||
  1228.          ($cupsuri =~ m!/dev/ptal-printd/(.+)$!) ||
  1229.          ($cupsuri =~ m!/var/run/ptal-printd/(.+)$!)) &&
  1230.         (-x "$sysdeps->{'cups-backends'}/ptal")) {
  1231.         # Translate URI for ptal-printd (does not work with CUPS
  1232.         # 1.1.12 and newer) to URI for the "ptal" CUPS backend
  1233.         # script (if the script is there)
  1234.         my $devname = $1;
  1235.         $devname =~ s/_/:/;
  1236.         $devname =~ s/_/:/;
  1237.         $cupsuri = "ptal:/$devname";
  1238.         } elsif ((($cupsuri =~ m!^$sysdeps->{'mtink-pipes'}/(.+)$!) ||
  1239.               ($cupsuri =~ m!^/var/mtink/(.+)$!)) &&
  1240.              (-x "$sysdeps->{'cups-backends'}/mtink")) {
  1241.         # Translate URI for mtinkd (does not work with CUPS
  1242.         # 1.1.12 and newer) to URI for the "mtink" CUPS backend
  1243.         # script (if the script is there)
  1244.         $cupsuri = "mtink:/$1";
  1245.         } elsif ($config->{'connect'} =~ m!usb!i) {
  1246.         $cupsuri = cups_usb_device_uri_to_printer_uri($cupsuri);
  1247.         $cupsuri = "usb:$cupsuri";
  1248.         } elsif (($cupsuri =~ m!lp[0-9]!) || ($cupsuri =~ m!LP[0-9]!)|| 
  1249.              ($cupsuri =~ m!parallel!)) {
  1250.         $cupsuri = "parallel:$cupsuri";
  1251.         } elsif (($cupsuri =~ m!tty!) || ($cupsuri =~ m!TTY!) || 
  1252.              ($cupsuri =~ m!serial!)) {
  1253.         $cupsuri = "serial:$cupsuri";
  1254.         } else {
  1255.         $cupsuri = "file:$cupsuri";
  1256.         }
  1257.     } elsif (($config->{'connect'} =~ m!^ptal://?([^/].*)$!) &&
  1258.          (!-x "$sysdeps->{'cups-backends'}/ptal")) {
  1259.         # If there is no "ptal" backend script for CUPS, use an URI
  1260.         # pointing to the pipe set up by ptal-printd.
  1261.         my $devname = $1;
  1262.         $devname =~ tr/:/_/;
  1263.         $cupsuri = "file:$sysdeps->{'ptal-pipes'}/$devname";
  1264.     } elsif (($config->{'connect'} =~ m!^mtink:/(.*)$!) &&
  1265.          (!-x "$sysdeps->{'cups-backends'}/mtink")) {
  1266.         # If there is no "mtink" backend script for CUPS, use an URI
  1267.         # pointing to the pipe set up by mtinkd.
  1268.         $cupsuri = "file:$sysdeps->{'mtink-pipes'}/$1";
  1269.     } else {
  1270.         $cupsuri=$config->{'connect'};
  1271.     }
  1272.     # Correct PTAL URIs: "ptal:/..." for HPOJ 0.9, "ptal://..." for newer
  1273.     # HPOJ
  1274.     if ($cupsuri =~ m!^ptal:/!) {
  1275.         $cupsuri = cups_correct_ptal_uri($cupsuri);
  1276.     }
  1277.     }
  1278.  
  1279.     # Are there changes in the error handling of the backend?
  1280.     if (((defined($config->{'dd'})) && 
  1281.      (((defined($beh->{'dd'})) && 
  1282.        ($config->{'dd'} ne $beh->{'dd'})) ||
  1283.       ($config->{'dd'} != 0))) ||
  1284.     ((defined($config->{'att'})) && 
  1285.      (((defined($beh->{'att'})) && 
  1286.        ($config->{'att'} ne $beh->{'att'})) ||
  1287.       ($config->{'att'} != 1))) ||
  1288.     ((defined($config->{'delay'})) && 
  1289.      (((defined($beh->{'delay'})) &&
  1290.        ($config->{'delay'} ne $beh->{'delay'})) ||
  1291.       ($config->{'delay'} != 30)))) {
  1292.     if (!defined($config->{'dd'})) {
  1293.         $config->{'dd'} = (defined($beh->{'dd'}) ? $beh->{'dd'} : 0);
  1294.     }
  1295.     if (!defined($config->{'att'})) {
  1296.         $config->{'att'} = (defined($beh->{'att'}) ? $beh->{'att'} : 1);
  1297.     }
  1298.     if (!defined($config->{'delay'})) {
  1299.         $config->{'delay'} = (defined($beh->{'delay'}) ? 
  1300.                   $beh->{'delay'} : 30);
  1301.     }
  1302.     $cupsuri = $beh->{'uri'} if !$cupsuri;
  1303.     # Do only add the "beh" wrapper backend when it is really needed
  1304.     # (More than one retry and/or no disabling) and if the queue is not
  1305.     # using the HPLIP ("hp") backend, as otherwise the "hp-toolbox"
  1306.     # will not list the printer any more. HPLIP does infinite retries
  1307.     # in 30-sec intervals anyway.
  1308.     if (($cupsuri) && ($cupsuri !~ m!^hp(fax|):/!) &&
  1309.         (($config->{'dd'} != 0) || ($config->{'att'} != 1))) {
  1310.         $cupsuri = sprintf("beh:/%d/%d/%d/%s",
  1311.                    $config->{'dd'}, $config->{'att'},
  1312.                    $config->{'delay'}, $cupsuri);
  1313.     }
  1314.     }
  1315.  
  1316.     if ($cupsuri) {
  1317.     $lpadminline .= " -v \"$cupsuri\"";
  1318.     }
  1319.  
  1320.     # Directory setup, let the Foomatic PPD directory for CUPS be the same 
  1321.     # as /etc/cups/ppd/ (where CUPS stores the PPDs of the installed queues)
  1322.     mkdir $sysdeps->{'foo-etc'}, 0755;
  1323.     symlink "$sysdeps->{'cups-etc'}/ppd/", "$sysdeps->{'foo-etc'}/cups";
  1324.  
  1325.     # In CUPS we never have a $postpipe
  1326.     # (when we get a $postpipe from a source PPD file from another
  1327.     # spooler, we don't need to remove it really, because it will be
  1328.     # ignored by foomatic-rip, uncomment this to remove it)
  1329.  
  1330.     #$db->{'dat'}{'postpipe'} = "";
  1331.  
  1332.     # Generate/write te PPD file
  1333.     writeppdfile($config, $ppdfile, $rawqueue, $newfoomaticdata);
  1334.  
  1335.     # Execute the lpadmin command to set up the new queue
  1336.  
  1337.     if (system $lpadminline) {
  1338.     # Remove the config files
  1339.     unlink "$ppdfile"
  1340.         if (-f "$ppdfile");
  1341.     # Revert changed config files
  1342.     rename "$ppdfile.old", "$ppdfile"
  1343.         if (-f "$ppdfile.old");
  1344.     die "Could not set up/change the queue \"$config->{'queue'}\"!\n";
  1345.     }
  1346.  
  1347.     return 1;
  1348. }
  1349.  
  1350. sub default_cups {
  1351.     my ($config) = $_[0];
  1352.  
  1353.     if ($< == 0) {
  1354.     # (/etc/cups/printers.conf can only be manipulated by root)
  1355.     # This line sets the default printer in /etc/cups/printers.conf
  1356.     my $command = "$sysdeps->{'cups-admin'} -d " .
  1357.         "\"$config->{'queue'}\" > /dev/null";
  1358.  
  1359.     # Do it! (Ignore errors silently)
  1360.     system $command;
  1361.     }
  1362.  
  1363.     # This line sets the default printer in /etc/cups/lpoptions
  1364.     # (required for setting a remote queue as default)
  1365.     my $command = "$sysdeps->{'cups-lpoptions'} -d " .
  1366.     "\"$config->{'queue'}\" > /dev/null";
  1367.  
  1368.     # Do it!
  1369.     system $command and
  1370.         die "Unable to set queue \"$config->{'queue'}\" as default!\n";
  1371.  
  1372. }
  1373.  
  1374. sub delete_cups {
  1375.     my ($config) = $_[0];
  1376.  
  1377.     # This line deletes the old printer queue
  1378.     my $queuedeleteline =
  1379.     "$sysdeps->{'cups-admin'} -x \"$config->{'queue'}\"";
  1380.  
  1381.     # Do it!
  1382.     system $queuedeleteline and
  1383.     die "Unable to delete queue \"$config->{'queue'}\"!\n";
  1384.  
  1385.     return 1;
  1386. }
  1387.  
  1388. sub query_cups {
  1389.     my ($config) = @_;
  1390.  
  1391.     # User requests data of a printer/driver combo to see the options before
  1392.     # installing a queue
  1393.     if (($opt_P) && ((($config->{'driver'}) && ($config->{'printer'}) &&
  1394.     ($config->{'driver'} ne "raw")) || ($config->{'ppdfile'}))) {
  1395.     if ($opt_n) {
  1396.         my $olddatablob = load_cups_datablob($opt_n);
  1397.         print_perl_combo_data($config, $olddatablob);
  1398.     } else {
  1399.         print_perl_combo_data($config);
  1400.     }
  1401.     return;
  1402.     }
  1403.  
  1404.     my $i = $ARGV[0];
  1405.     if (!defined($i)) {$i = 0;}
  1406.  
  1407.     my $pconf = load_cups_printersconf();
  1408.     if (defined($opt_r)) {$opt_r = undef;}
  1409.     my $p;
  1410.  
  1411.     if (!$opt_P) {
  1412.     print "<queues>\n";
  1413.     }
  1414.  
  1415.     # Query the default printer
  1416.     my $default = '';
  1417.     if (!defined($config->{'queue'})) {
  1418.     open DEFAULT, "$sysdeps->{'cups-lpstat'} -d |" or
  1419.         die "Could not run $sysdeps->{'cups-lpstat'}!\n";
  1420.     my $defaultstr = <DEFAULT>;
  1421.     close DEFAULT;
  1422.     if ($defaultstr =~ m!\S+:\s+(\S+)$!) {
  1423.         $default = $1;
  1424.         if (!$opt_P) {
  1425.         print "<defaultqueue>$default</defaultqueue>\n";
  1426.         }
  1427.     }
  1428.     }
  1429.  
  1430.     for $p (@{$pconf}) {
  1431.     
  1432.     # were we invoked for only one queue?
  1433.     next if (defined($config->{'queue'})
  1434.          and $config->{'queue'} ne $p->{'name'});
  1435.  
  1436.     # load the queue data
  1437.     $db->{'dat'} = load_cups_datablob($p->{'name'});
  1438.  
  1439.     # Enter info for remote queue
  1440.     if ($p->{'remote'}) {
  1441.         $db->{'dat'}{'queuedata'}{'foomatic'} = 0;
  1442.         $db->{'dat'}{'queuedata'}{'spooler'} = 'cups';
  1443.         $db->{'dat'}{'queuedata'}{'queue'} = $p->{'name'};
  1444.         $db->{'dat'}{'queuedata'}{'connect'} = $p->{'DeviceURI'};
  1445.         $db->{'dat'}{'queuedata'}{'description'} = $p->{'Info'};
  1446.         $db->{'dat'}{'queuedata'}{'loc'} = $p->{'Location'};
  1447.         $db->{'dat'}{'queuedata'}{'remote'} = 1;
  1448.     } else {
  1449.         $db->{'dat'}{'queuedata'}{'remote'} = 0;
  1450.     }
  1451.  
  1452.     # extract the queue data block
  1453.     my $c = $db->{'dat'}{'queuedata'};
  1454.  
  1455.     if ($opt_P) {
  1456.         if ($p->{'name'} eq $default) {
  1457.         $db->{'dat'}{'queuedata'}{'default'} = 1;
  1458.         } else {
  1459.         $db->{'dat'}{'queuedata'}{'default'} = 0;
  1460.         }
  1461.         my $asciidata = $db->getascii();
  1462.         $asciidata =~ s/\$VAR1/\$QUEUES[$i]/g;
  1463.         print $asciidata;
  1464.         $i ++;
  1465.     } else {
  1466.         # and get it to standard output
  1467.         dump_config($c);
  1468.     }
  1469.     }
  1470.  
  1471.     if (!$opt_P) {
  1472.     print "</queues>\n";
  1473.     }
  1474.     
  1475.     return;
  1476. }
  1477.  
  1478. ### Queue manipulation functions for PDQ
  1479.  
  1480. sub setup_pdq {
  1481.     my ($config) = $_[0];
  1482.  
  1483.     # Read the previous /usr/lib/pdq/printrc
  1484.     my $printrc = load_pdq_printrc();
  1485.  
  1486.     my ($ppdfile, $driverfile, $entry, $reconf, $p);
  1487.     $reconf = 0;
  1488.     for $p (@{$printrc}) {
  1489.     if ((defined($p->{'name'})) &&
  1490.         ($p->{'name'} eq $config->{'queue'})) {
  1491.         $entry = $p;
  1492.         $reconf = 1;
  1493.         last;
  1494.  
  1495.         use Data::Dumper;
  1496.         print "Reconfigure of ", Dumper($p);
  1497.     }
  1498.     }
  1499.  
  1500.     # Config file names
  1501.     $ppdfile = sprintf('%s/pdq/%s.ppd',
  1502.                   $sysdeps->{'foo-etc'},
  1503.                   $config->{'queue'});
  1504.     $driverfile = sprintf('%s/pdq/driverdescr/%s.pdq',
  1505.                   $sysdeps->{'foo-etc'},
  1506.                   $config->{'queue'});
  1507.  
  1508.     # Get the data from the former queue if we reconfigure or copy a queue
  1509.     # do also some checking of the user-supplied parameters
  1510.     my ($rawqueue, $newfoomaticdata, $makemodel) =
  1511.     getoldqueuedata($config, $reconf);
  1512.  
  1513.     # Set the initial line of the "printer" block in /usr/lib/pdq/printrc
  1514.     $entry->{'name'} = $config->{'queue'};
  1515.  
  1516.     # Location field
  1517.     if ((defined($config->{'loc'})) || (!$reconf)) {
  1518.     $entry->{'location'} = "\"$config->{'loc'}\"";
  1519.     }
  1520.  
  1521.     # Model/Description field
  1522.     if (defined($config->{'desc'})) {
  1523.     $entry->{'model'} = "\"$config->{'desc'}\"";
  1524.     } elsif (!$entry->{'model'}) {
  1525.     if (!$rawqueue) {
  1526.         $entry->{'model'} = "\"$makemodel\"";
  1527.     } else {
  1528.         $entry->{'model'} = "\"Raw printer\"";
  1529.     }
  1530.     }
  1531.  
  1532.     # Create directories
  1533.     mkdir $sysdeps->{'foo-etc'}, 0755;
  1534.     mkdir $sysdeps->{'foo-etc'} . '/pdq', 0755;
  1535.     mkdir $sysdeps->{'foo-etc'} . '/pdq/driverdescr', 0755;
  1536.     # Make the printer driver descriptions in /etc/foomatic/pdq visible
  1537.     # for PDQ
  1538.     # symlink $sysdeps->{'foo-etc'} . '/pdq', $sysdeps->{'pdq-foomatic'};
  1539.  
  1540.     # Save old driver file, use the "~" to make it appear an editor
  1541.     # backup so that PDQ does not parse it.
  1542.     # Save old $driverfile, if any
  1543.     rename $driverfile, "$driverfile.old~" 
  1544.     if (-f $driverfile);
  1545.  
  1546.     # Generate/write the PPD file
  1547.     writeppdfile($config, $ppdfile, $rawqueue, $newfoomaticdata);
  1548.  
  1549.     # Create driver description file
  1550.     if ($rawqueue) {
  1551.     system("$sysdeps->{'foomatic-rip'} --genrawpdq $driverfile") and
  1552.         die "Cannot create $driverfile!\n";
  1553.     } else {
  1554.     system("$sysdeps->{'foomatic-rip'} --ppd \'$ppdfile\' --genpdq " .
  1555.            "$driverfile") and
  1556.         die "Cannot create $driverfile!\n";
  1557.     }
  1558.  
  1559.     # PDQ configuration file
  1560.  
  1561.     # Driver fields
  1562.  
  1563.     # Extract driver name
  1564.     my $driverdesc = `cat $driverfile`;
  1565.     $driverdesc =~ m!^\s*driver\s*(\"\S*\-\d+\")!m;
  1566.  
  1567.     # Driver-specific entries
  1568.     $entry->{'driver'} = $1;
  1569.     $entry->{'driver_opts'} = "\{ \}";
  1570.     $entry->{'driver_args'} = "\{ \}";
  1571.  
  1572.     # Interface fields
  1573.  
  1574.     # All URIs ("-c" option) have the same syntax as URIs in CUPS ("-v"
  1575.     # option of "lpadmin").
  1576.     if ($config->{'connect'} =~ m!^(file|usb|parallel|serial):(.*)!) {
  1577.     # Local printer or printing to a file
  1578.     my $file = $2;
  1579.     if ($config->{'connect'} =~ m!^usb://!) {
  1580.         # Queue with printer-bound USB URI transferred from CUPS,
  1581.         # as PDQ does not support these URIs, translate it
  1582.         # back to a standard USB device URI
  1583.         $file = cups_usb_printer_uri_to_device_uri($file);
  1584.     }
  1585.     if (! -e $file) {
  1586.         warn "The device or file $file doesn't exist? " .
  1587.         "Working anyway.\n";
  1588.     }
  1589.     $entry->{'interface'} = "\"local-port\"";
  1590.     $entry->{'interface_opts'} = "\{ \}";
  1591.     $entry->{'interface_args'} = "\{ \"PORT\" = \"$file\" \}";
  1592.     } elsif ($config->{'connect'} =~ m!^ptal://?([^/].*)$!) {
  1593.     # HPOJ MLC protocol
  1594.     my $devname = $1;
  1595.     $devname =~ tr/:/_/;
  1596.     $entry->{'interface'} = "\"local-port\"";
  1597.     $entry->{'interface_opts'} = "\{ \}";
  1598.     $entry->{'interface_args'} = "\{ \"PORT\" = " .
  1599.         "\"$sysdeps->{'ptal-pipes'}/$devname\" \}";
  1600.     } elsif ($config->{'connect'} =~ m!^mtink:/(.+)$!) {
  1601.     # Printing through "mtinkd"
  1602.     $entry->{'interface'} = "\"local-port\"";
  1603.     $entry->{'interface_opts'} = "\{ \}";
  1604.     $entry->{'interface_args'} = "\{ \"PORT\" = " .
  1605.         "\"$sysdeps->{'mtink-pipes'}/$1\" \}";
  1606.     } elsif ($config->{'connect'} =~ m!^lpd://([^/]+)/([^/]+)$!) {
  1607.     # Remote LPD
  1608.     my $remhost = $1;
  1609.         my $remqueue = $2;
  1610.     $entry->{'interface'} = "\"bsd-lpd\"";
  1611.     $entry->{'interface_opts'} = "\{ \}";
  1612.     $entry->{'interface_args'} = 
  1613.         "\{ \"QUEUE\" = \"$remqueue\", \"REMOTE_HOST\" = " .
  1614.         "\"$remhost\" \}";
  1615.     } elsif ($config->{'connect'} =~ m!^socket://([^/:]+):([0-9]+)/?$!) {
  1616.     # Socket (AppSocket/HP JetDirect)
  1617.     my $remhost = $1;
  1618.         my $remport = $2;
  1619.     $entry->{'interface'} = "\"tcp-port\"";
  1620.     $entry->{'interface_opts'} = "\{ \}";
  1621.     $entry->{'interface_args'} = 
  1622.         "\{ \"REMOTE_PORT\" = \"$remport\", \"REMOTE_HOST\" = " .
  1623.         "\"$remhost\" \}";
  1624.     } elsif ($config->{'connect'}) {
  1625.     die ("The URI \"$config->{'connect'}\" is not supported " .
  1626.          "for PDQ or you have\nmistyped.\n");
  1627.     } elsif (!$reconf) {
  1628.     die "You must specify a connection with -c.\n";
  1629.     }
  1630.  
  1631.     # Add to the printrc if it is a new entry
  1632.     if (!$reconf) {
  1633.     push(@{$printrc}, $entry);
  1634.     }
  1635.  
  1636.     # Write back the modified printrc file
  1637.     my $printrcname = $sysdeps->{'pdq-printrc'};
  1638.     rename $printrcname, "$printrcname.old" or
  1639.     die "Cannot backup $printrcname!\n";
  1640.     open PRINTRC, "> $printrcname" or die "Cannot write $printrcname!\n";
  1641.     print PRINTRC dump_pdq_printrc($printrc);
  1642.     close PRINTRC;
  1643.     chmod 0644, $printrcname;
  1644.  
  1645.     return 1;
  1646. }
  1647.  
  1648. sub default_pdq {
  1649.     my ($config) = $_[0];
  1650.  
  1651.     # Determine the name of the config file to modify
  1652.     my $printrcname = "";
  1653.     if ($< == 0) {
  1654.     $printrcname = "$sysdeps->{'pdq-printrc'}";
  1655.     if (!(-f $printrcname)) {die "No file $printrcname!"};
  1656.     } else {
  1657.     $printrcname = "$ENV{HOME}/.printrc";
  1658.     if (!(-f $printrcname)) {system "touch $printrcname"};
  1659.     }
  1660.  
  1661.     # Read the config file
  1662.     open PRINTRC, "$printrcname" or die "Cannot open $printrcname!";
  1663.     my @printrc = <PRINTRC>;
  1664.     close PRINTRC;
  1665.  
  1666.     # Remove all valid "default_printer" lines
  1667.     ($_ =~ /^\s*default_printer/ and $_="") foreach @printrc;
  1668.  
  1669.     # Insert the new "default_printer" line
  1670.     push @printrc, "default_printer $config->{'queue'}\n";
  1671.  
  1672.     # Write back the modified config file
  1673.     open PRINTRC, "> $printrcname" or die "Cannot open $printrcname!";
  1674.     print PRINTRC @printrc;
  1675.     close PRINTRC;
  1676.  
  1677. }
  1678.  
  1679. sub delete_pdq {
  1680.     my ($config) = $_[0];
  1681.  
  1682.     my $name = $config->{'queue'};
  1683.  
  1684.     my $printrc = load_pdq_printrc();
  1685.  
  1686.     my @newrc;
  1687.     for (@{$printrc}) {
  1688.     push (@newrc, $_)
  1689.         unless (defined($_->{'name'}) && ($_->{'name'} eq $name));
  1690.     }
  1691.  
  1692.     my @newprintrc = dump_pdq_printrc(\@newrc);
  1693.  
  1694.     my $printrcname = $sysdeps->{'pdq-printrc'};
  1695.     rename $printrcname, "$printrcname.old" or
  1696.     die "Cannot backup $printrcname!\n";
  1697.     open PRINTRC, "> $printrcname" or die "Cannot write $printrcname!\n";
  1698.     print PRINTRC @newprintrc;
  1699.     close PRINTRC;
  1700.     chmod 0644, $printrcname;
  1701.  
  1702.     # Config file names
  1703.     my $ppdfile = sprintf('%s/pdq/%s.ppd',
  1704.               $sysdeps->{'foo-etc'},
  1705.               $config->{'queue'});
  1706.     my $driverfile = sprintf('%s/pdq/driverdescr/%s.pdq',
  1707.                  $sysdeps->{'foo-etc'},
  1708.                  $config->{'queue'});
  1709.  
  1710.     # Rename old $ppdfile, if any
  1711.     rename $ppdfile, "$ppdfile.old" 
  1712.     if (-f $ppdfile);
  1713.     # Rename old driverfile, if any, use the "~" to make it appear an 
  1714.     # editor backup so that PDQ does not parse it.
  1715.     # Rename old $driverfile, if any
  1716.     rename $driverfile, "$driverfile.old~" 
  1717.     if (-f $driverfile);
  1718.  
  1719.     return 1;
  1720. }
  1721.  
  1722. sub query_pdq {
  1723.     my ($config) = @_;
  1724.  
  1725.     # User requests data of a printer/driver combo to see the options before
  1726.     # installing a queue
  1727.     if (($opt_P) && ((($config->{'driver'}) && ($config->{'printer'}) &&
  1728.     ($config->{'driver'} ne "raw")) || ($config->{'ppdfile'}))) {
  1729.     if ($opt_n) {
  1730.         my $olddatablob = load_pdq_datablob($opt_n);
  1731.         print_perl_combo_data($config, $olddatablob);
  1732.     } else {
  1733.         print_perl_combo_data($config);
  1734.     }
  1735.     return;
  1736.     }
  1737.  
  1738.     my $i = $ARGV[0];
  1739.     if (!defined($i)) {$i = 0;}
  1740.  
  1741.     my $printrc = load_pdq_printrc();
  1742.     my $p;
  1743.  
  1744.     if (!$opt_P) {
  1745.     print "<queues>\n";
  1746.     }
  1747.  
  1748.     # Query the default printer
  1749.     my $default;
  1750.     if (!defined($config->{'queue'})) {
  1751.     open DEFAULT, "$sysdeps->{'pdq-print'} -h 2>&1 |" or
  1752.         die "Could not run $sysdeps->{'pdq-print'}!\n";
  1753.     my $defaultstr = join('', <DEFAULT>);
  1754.     close DEFAULT;
  1755.     if ($defaultstr =~ m!The\s+default\s+printer\s+is\s+(\S+)$!m) {
  1756.         $default = $1;
  1757.         if (!$opt_P) {
  1758.         print "<defaultqueue>$default</defaultqueue>\n";
  1759.         }
  1760.     }
  1761.     }
  1762.  
  1763.     for $p (@{$printrc}) {
  1764.  
  1765.     # Omit non-printer-block items
  1766.     next if (!(defined($p->{'name'})));
  1767.     
  1768.     # were we invoked for only one queue?
  1769.     next if (defined($config->{'queue'})
  1770.          and $config->{'queue'} ne $p->{'name'});
  1771.  
  1772.     # load the queue data
  1773.     $db->{'dat'} = load_pdq_datablob($p->{'name'});
  1774.  
  1775.     # extract the queue data block
  1776.         my $c = $db->{'dat'}{'queuedata'};
  1777.  
  1778.     if ($opt_P) {
  1779.         if ($p->{'name'} eq $default) {
  1780.         $db->{'dat'}{'queuedata'}{'default'} = 1;
  1781.         } else {
  1782.         $db->{'dat'}{'queuedata'}{'default'} = 0;
  1783.         }
  1784.         $db->{'dat'}{'queuedata'}{'remote'} = 0;
  1785.         my $asciidata = $db->getascii();
  1786.         $asciidata =~ s/\$VAR1/\$QUEUES[$i]/g;
  1787.         print $asciidata;
  1788.         $i ++;
  1789.     } else {
  1790.         # and get it to standard output
  1791.         dump_config($c);
  1792.     }
  1793.     }
  1794.  
  1795.     if (!$opt_P) {
  1796.     print "</queues>\n";
  1797.     }
  1798.     
  1799.     return;
  1800. }
  1801.  
  1802. ### Queue manipulation functions for PPR
  1803.  
  1804. sub setup_ppr {
  1805.     my ($config) = $_[0];
  1806.  
  1807.     # Read the previous configuration
  1808.     my $printrc = load_ppr_printers_conf();
  1809.  
  1810.     my ($ppdfile, $entry, $reconf, $p);
  1811.     $reconf = 0;
  1812.     for $p (@{$printrc}) {
  1813.     if ((defined($p->{'name'})) &&
  1814.         ($p->{'name'} eq $config->{'queue'})) {
  1815.         $entry = $p;
  1816.         $reconf = 1;
  1817.         last;
  1818.  
  1819.         use Data::Dumper;
  1820.         print "Reconfigure of ", Dumper($p);
  1821.     }
  1822.     }
  1823.  
  1824.     # PPD file name
  1825.     $ppdfile = sprintf('%s/ppr/%s.ppd',
  1826.                   $sysdeps->{'foo-etc'},
  1827.                   $config->{'queue'});
  1828.  
  1829.     # Determine the PPR version in use
  1830.     my $pprversion;
  1831.     if (open VER, "$sysdeps->{'ppr-pprd'} --version |") {
  1832.     my $ver = <VER>;
  1833.     close VER;
  1834.     $ver =~ /^\D*(\d+)\.(\d+)(\.(\d+)|)((a|alpha|b|beta|r|rc)(\d+|)|)/;
  1835.     $pprversion = (1e8 * $1 + 1e6 * $2 + 1e4 * $4 +
  1836.                ($5 ? 100 * (ord(uc($6)) - 64) + $7 : 9999)) / 1e8;
  1837.     } else {
  1838.     # Could not determine version, so we set it to 0 (oldest possible)
  1839.     $pprversion = 0;
  1840.     }
  1841.  
  1842.     # Get the data from the former queue if we reconfigure or copy a queue
  1843.     # do also some checking of the user-supplied parameters
  1844.     my ($rawqueue, $newfoomaticdata, $makemodel) =
  1845.     getoldqueuedata($config, $reconf);
  1846.  
  1847.     # Read out previous interface settings
  1848.     my $interface = "";
  1849.     my $address = "";
  1850.     my $options = "";
  1851.     my $interface_options = "";
  1852.     if ($reconf) {
  1853.     $interface = $entry->{'Interface'};
  1854.     $address = $entry->{'Address'};
  1855.     $interface_options = $entry->{'Options'};
  1856.     if (($interface eq "foomatic-rip") ||
  1857.         ($interface eq "ppromatic")) {
  1858.         if ($interface_options =~ /backend=(\S+)/) {
  1859.         $interface = $1;
  1860.         $interface_options =~ s/backend=(\S+)//;
  1861.         if ($interface_options =~ /^\s*$/) {
  1862.             $interface_options = "";
  1863.         }
  1864.         } else {
  1865.         $interface = "";
  1866.         }
  1867.     }
  1868.     }
  1869.  
  1870.     # All URIs ("-c" option) have the same syntax as URIs in CUPS ("-v"
  1871.     # option of "lpadmin").
  1872.  
  1873.     if (defined($config->{'connect'})) {
  1874.     $interface_options =~ s/smbuser=(\S+)//;
  1875.     $interface_options =~ s/smbpassword=(\S+)//;
  1876.     if ($config->{'connect'} =~ m!^(file|usb|parallel|serial):(.*)!) {
  1877.         # Local printer or printing to a file
  1878.         $address = $2;
  1879.         if ($config->{'connect'} =~ m!^usb://!) {
  1880.         # Queue with printer-bound USB URI transferred from CUPS,
  1881.         # as PPR does not support these URIs, translate it
  1882.         # back to a standard USB device URI
  1883.         $address = cups_usb_printer_uri_to_device_uri($address);
  1884.         }
  1885.         if (! -e $address) {
  1886.         warn "The device or file $address doesn't exist? " .
  1887.             "Working anyway.\n";
  1888.         }
  1889.         if (($address =~ m!usb!) || ($address =~ m!USB!) ||
  1890.         ($address =~ m!$sysdeps->{'ptal-pipes'}!) || 
  1891.         ($address =~ m!/dev/ptal-printd!) ||
  1892.         ($address =~ m!/var/run/ptal-printd!) ||
  1893.         ($address =~ m!$sysdeps->{'mtink-pipes'}!) || 
  1894.         ($address =~ m!/var/mtink!)) {
  1895.         $interface = "simple";
  1896.         } elsif (($address =~ m!lp[0-9]!) || ($address =~ m!LP[0-9]!) || 
  1897.              ($address =~ m!parallel!)) {
  1898.         $interface = "parallel";
  1899.         } elsif (($address =~ m!tty!) || ($address =~ m!TTY!) || 
  1900.              ($address =~ m!serial!)) {
  1901.         $interface = "serial";
  1902.         } else {
  1903.         $interface = "dummy";
  1904.         }
  1905.         $options = "";
  1906.     } elsif ($config->{'connect'} =~ m!^ptal://?([^/].*)$!) {
  1907.         # HPOJ MLC protocol
  1908.         my $devname = $1;
  1909.         $devname =~ tr/:/_/;
  1910.         $address = "$sysdeps->{'ptal-pipes'}/$devname";
  1911.         $interface = "simple";
  1912.         $options = "";
  1913.     } elsif ($config->{'connect'} =~ m!^mtink:/(.+)$!) {
  1914.         # Printing through "mtinkd"
  1915.         $address = "$sysdeps->{'mtink-pipes'}/$1";
  1916.         $interface = "simple";
  1917.         $options = "";
  1918.     } elsif ($config->{'connect'} =~ m!^lpd://([^/]+)/([^/]+)$!) {
  1919.         # Remote LPD
  1920.         my $remhost = $1;
  1921.         my $remqueue = $2;
  1922.         $address = "${remqueue}\@${remhost}";
  1923.         $interface = "lpr";
  1924.         $options = "";
  1925.     } elsif ($config->{'connect'} =~
  1926.          m!^socket://([^/:]+):([0-9]+)/?$!) {
  1927.         # Socket (AppSocket/HP JetDirect)
  1928.         my $remhost = $1;
  1929.         my $remport = $2;
  1930.         $address = "$remhost:$remport";
  1931.         $interface = "tcpip";
  1932.         $options = "";
  1933.     } elsif ($config->{'connect'} =~ m!^smb://(.*)$!) {
  1934.         # SMB (Printer on Windows server)
  1935.         my $parameters = $1;
  1936.         # Get the user's login and password from the URI
  1937.         my $smbuser = "";
  1938.         my $smbpassword = "";
  1939.         if ($parameters =~ m!([^@]*)@([^@]+)!) {
  1940.         my $login = $1;
  1941.         $parameters = $2;
  1942.         if ($login =~ m!([^:]*):([^:]*)!) {
  1943.             $smbuser = $1;
  1944.             $smbpassword = $2;
  1945.         } else {
  1946.             $smbuser = $login;
  1947.             $smbpassword = "";
  1948.         }
  1949.         } else {
  1950.         $smbuser = "GUEST";
  1951.         $smbpassword = "";
  1952.         }
  1953.         # When a password is given, a user name should be given, too.
  1954.         if (($smbpassword ne "") && ($smbuser eq "")) {
  1955.         $smbuser = "GUEST";
  1956.         }
  1957.         # The "smb" interface of PPR uses "ppr" as the SMB user when no
  1958.         # user name is given. Usually one does not have such a user name
  1959.         # under Windows. So use "GUEST" if no user name is given.
  1960.         if ($smbuser eq "") {
  1961.         $smbuser = "GUEST";
  1962.         }
  1963.         # Set the options for PPR's "smb" interface
  1964.         $options = "";
  1965.         if ($smbuser ne "") {
  1966.         $options = "smbuser=\"$smbuser\"";
  1967.         if ($smbpassword ne "") {
  1968.             $options .= " smbpassword=\"$smbpassword\"";
  1969.         }
  1970.         }
  1971.         # Get the workgroup, server, and share name
  1972.         my $workgroup = "";
  1973.         my $smbserver = "";
  1974.         my $smbshare = "";
  1975.         if ($parameters =~ m!([^/]*)/([^/]+)/([^/]+)$!) {
  1976.         $workgroup = $1;
  1977.         $smbserver = $2;
  1978.         $smbshare = $3;
  1979.         } elsif ($parameters =~ m!([^/]+)/([^/]+)$!) {
  1980.         $workgroup = "";
  1981.         $smbserver = $1;
  1982.         $smbshare = $2;
  1983.         } else {
  1984.         die "The \"smb://\" URI must at least contain the " .
  1985.             "server name and the share name!\n";
  1986.         }
  1987.         $address = "//$smbserver/$smbshare";
  1988.         $interface = "smb";
  1989.     } else {
  1990.         die ("The URI \"$config->{'connect'}\" is not supported for " .
  1991.          "PPR or you have\nmistyped.\n");
  1992.     }
  1993.     } elsif (!$reconf) {
  1994.     die "You must specify a connection with -c.\n";
  1995.     }
  1996.  
  1997.     # Here we set up the command line for the "ppad interface" and the
  1998.     # "ppad options" commands
  1999.     my $ppad_interface = "";
  2000.     my $ppad_options = "";
  2001.     my $ppad_rip = "";
  2002.     if ($rawqueue) {
  2003.     $ppad_interface = "$sysdeps->{'ppr-ppad'} interface " .
  2004.         "\"$config->{'queue'}\" $interface \"$address\"";
  2005.     $ppad_options = "$sysdeps->{'ppr-ppad'} options " .
  2006.         "\"$config->{'queue'}\" $options $interface_options";
  2007.     $ppad_rip = "$sysdeps->{'ppr-ppad'} " .
  2008.         "rip \"$config->{'queue'}\"";
  2009.     } else {
  2010.     if ($pprversion >= 1.50000102 ) { #1.50a2
  2011.         $ppad_interface = "$sysdeps->{'ppr-ppad'} interface " .
  2012.         "\"$config->{'queue'}\" $interface \"$address\"";
  2013.         $ppad_options = "$sysdeps->{'ppr-ppad'} options " .
  2014.         "\"$config->{'queue'}\" $options $interface_options";
  2015.         if ($db->{'dat'}{'id'}) {
  2016.         $ppad_rip = "$sysdeps->{'ppr-ppad'} " .
  2017.             "rip \"$config->{'queue'}\" foomatic-rip x" .
  2018.             # PPR 1.50a2 has a bug and needs at least one option for
  2019.             # the command line of the PPR RIP, therefore we add the
  2020.             # "0" in this case. The number is very likely not the
  2021.             # name of any boolean option, so it will be ignored by 
  2022.             # foomatic-rip
  2023.             (($pprversion < 1.50000103 ) ? " 0" : "");
  2024.         } else {
  2025.         $ppad_rip = "$sysdeps->{'ppr-ppad'} " .
  2026.             "rip \"$config->{'queue'}\"";
  2027.         }
  2028.     } else {
  2029.         $ppad_interface = "$sysdeps->{'ppr-ppad'} interface " .
  2030.         "\"$config->{'queue'}\" foomatic-rip \"$address\"";
  2031.         $ppad_options = "$sysdeps->{'ppr-ppad'} options " .
  2032.         "\"$config->{'queue'}\" backend=\"$interface\" " .
  2033.         "$options $interface_options";
  2034.         $ppad_rip = "$sysdeps->{'ppr-ppad'} " .
  2035.         "rip \"$config->{'queue'}\"";
  2036.     }
  2037.     }
  2038.  
  2039.     # Execute the ppad commands to set up the new queue
  2040.  
  2041.     if ((system $ppad_interface) ||
  2042.     (system $ppad_options) ||
  2043.     (system $ppad_rip)) {
  2044.     die "Could not set up/change the queue \"$config->{'queue'}\"!\n";
  2045.     }
  2046.  
  2047.     # Use manufacturer and model as description when no description is
  2048.     # provided
  2049.     my($comment, $olddesc);
  2050.     if (defined($config->{'desc'})) {
  2051.     $comment = $config->{'desc'};
  2052.     } else {
  2053.     # Before we overwrite the description field with manufacturer
  2054.     # and model, check if there is some old contents
  2055.     if (($reconf) && ($entry->{'Comment'})) {
  2056.         $olddesc = $entry->{'Comment'};
  2057.     }
  2058.     if (!$olddesc) {
  2059.         if (!$rawqueue) {
  2060.         $comment = "$makemodel";
  2061.         } else {
  2062.         $comment = "Raw queue";
  2063.         }
  2064.     }
  2065.     }
  2066.     if ($comment) {
  2067.     my $ppad_comment = "$sysdeps->{'ppr-ppad'} comment " .
  2068.         "\"$config->{'queue'}\" \"$comment\"";
  2069.     if (system $ppad_comment) {
  2070.         warn "Could not set description for the queue " .
  2071.         "\"$config->{'queue'}\"!\n";
  2072.     }
  2073.     }
  2074.  
  2075.     # Fill in the "location" field if something for it is provided.
  2076.     if (defined($config->{'loc'})) {
  2077.     my $ppad_location = "$sysdeps->{'ppr-ppad'} location " .
  2078.         "\"$config->{'queue'}\" \"$config->{'loc'}\"";
  2079.     if (system $ppad_location) {
  2080.         warn "Could not set location for the queue " .
  2081.         "\"$config->{'queue'}\"!\n";
  2082.     }
  2083.     }
  2084.  
  2085.     # Various file setup
  2086.     mkdir $sysdeps->{'foo-etc'}, 0755;
  2087.     mkdir $sysdeps->{'foo-etc'} . '/ppr', 0755;
  2088.  
  2089.     # Generate/write the PPD file
  2090.     writeppdfile($config, $ppdfile, $rawqueue, $newfoomaticdata);
  2091.  
  2092.     if ($rawqueue) {
  2093.     my $ppad_ppd = "$sysdeps->{'ppr-ppad'} ppd " .
  2094.         "\"$config->{'queue'}\" \"\" 2> /dev/null";
  2095.     if (!system $ppad_ppd) {
  2096.         # Automatic input tray selection not activated by default,
  2097.         # because the feature requires manual choice of the paper types
  2098.         # in the trays and other spoolers than PPR do not have automatic
  2099.         # paper tray selection. In addition "ppop media <queue>" is
  2100.         # broken for printers with a high number of input trays in their
  2101.         # PPD files.
  2102.         #my $ppad_bins = "$sysdeps->{'ppr-ppad'} bins delete " .
  2103.             #"\"$config->{'queue'}\" \"" . 
  2104.         #join ('" "', @{$entry->{'Bins'}}) . "\"";
  2105.         #if (system $ppad_bins) {
  2106.         #warn "Could not set paper input trays for the " .
  2107.             #"queue \"$config->{'queue'}\"!\n";
  2108.         #}
  2109.         my $ppad_deffiltopts = "$sysdeps->{'ppr-ppad'} " .
  2110.         "deffiltopts \"$config->{'queue'}\" 2> /dev/null";
  2111.         if (system $ppad_deffiltopts) {
  2112.         warn "Could not set \"DefFiltOpts\" entry for " .
  2113.             "the queue \"$config->{'queue'}\"!\n";
  2114.         }
  2115.     } else {
  2116.         die "Could not set PPD for the queue \"$config->{'queue'}\"!\n";
  2117.     }
  2118.     } else {
  2119.     my $ppad_ppd = "$sysdeps->{'ppr-ppad'} ppd " .
  2120.         "\"$config->{'queue'}\" \"$ppdfile\" 2> /dev/null";
  2121.     if (!system $ppad_ppd) {
  2122.         # Automatic input tray selection not activated by default,
  2123.         # because the feature requires manual choice of the paper types
  2124.         # in the trays and other spoolers than PPR do not have automatic
  2125.         # paper tray selection. In addition "ppop media <queue>" is
  2126.         # broken for printers with a high number of input trays in their
  2127.         # PPD files.
  2128.         #my $ppad_bins = "$sysdeps->{'ppr-ppad'} bins ppd " .
  2129.         #"\"$config->{'queue'}\"";
  2130.         #if (system $ppad_bins) {
  2131.         #warn "Could not set paper input trays for the " .
  2132.             #"queue \"$config->{'queue'}\"!\n";
  2133.         #}
  2134.         my $ppad_deffiltopts = "$sysdeps->{'ppr-ppad'} " .
  2135.         "deffiltopts \"$config->{'queue'}\" 2> /dev/null";
  2136.         if (system $ppad_deffiltopts) {
  2137.         warn "Could not set \"DefFiltOpts\" entry for the " .
  2138.             "queue \"$config->{'queue'}\"!\n";
  2139.         }
  2140.     } else {
  2141.         die "Could not set PPD for the queue \"$config->{'queue'}\"!\n";
  2142.     }
  2143.     }
  2144.  
  2145.  
  2146.     if ($rawqueue) {
  2147.  
  2148.     # If we have a raw queue, delete the PPD file if there is still
  2149.     # one from a former queue.
  2150.  
  2151.     unlink "$ppdfile"
  2152.         if (-f "$ppdfile");
  2153.     } else {
  2154.  
  2155.     # Clean up "Switchset" entry
  2156.  
  2157.     my @switchset = split('|', $entry->{'Switchset'});
  2158.     my @newswitchset = ();
  2159.     for my $option (@switchset) {
  2160.         if (!(($option =~ /^F\s*\*([^\*\s=:]+)\s+([^\*\s=:]+)\s*$/) ||
  2161.           ($option =~ /^F\s*([^\*\s=:]+)\s*=\s*([^\*\s=:]+)\s*$/) ||
  2162.           ($option =~ /^F\s*\*([^\*\s=:]+)\s*$/) ||
  2163.           ($option =~ /^F\s*([^\*\s=:]+)\s*$/))) {
  2164.         # The option is not a PPD option, keep it.
  2165.         # PPD options are incorporated in the PPD file now and so
  2166.         # they can be dropped in the "Switchset".
  2167.         if ($option =~ /^\s*(\S)(.*)$/) {
  2168.             push (@newswitchset, "-$1 \"$2\"");
  2169.         }
  2170.         }
  2171.         
  2172.     }
  2173.     my $ppad_switchset = "$sysdeps->{'ppr-ppad'} switchset " .
  2174.         "\"$config->{'queue'}\" " . join (' ', @newswitchset);
  2175.     if (system $ppad_switchset) {
  2176.         warn "Could not set switchset for the queue " .
  2177.         "\"$config->{'queue'}\"!\n";
  2178.     }
  2179.  
  2180.     # Check, if there is a PJL option and set the "Jobbreak" to "none"
  2181.     # because otherwise there is a Ctrl+D between the PJL frame added
  2182.     # by foomatic-rip and the PostScript job. This breaks printing of
  2183.     # certain PS files as the CUPS test page.
  2184.  
  2185.     my $pjloption = 0;
  2186.     for my $arg (@{$db->{'dat'}->{'args'}}) {
  2187.         if ($arg->{'style'} eq "J") {
  2188.         $pjloption = 1;
  2189.         last;
  2190.         }
  2191.     }
  2192.     if ($pjloption) {
  2193.         my $ppad_jobbreak = "$sysdeps->{'ppr-ppad'} jobbreak " .
  2194.         "\"$config->{'queue'}\" none";
  2195.         if (system $ppad_jobbreak) {
  2196.         warn "Could not set \"Jobbreak\" entry for the " .
  2197.             "queue \"$config->{'queue'}\"!\n";
  2198.         }
  2199.     }
  2200.     }
  2201.  
  2202.     return 1;
  2203. }
  2204.  
  2205. sub default_ppr {
  2206.     my ($config) = $_[0];
  2207.  
  2208.     # The default printer under PPR is the printer named "default". To be
  2209.     # able to easily switch the default printer we set up a printer group
  2210.     # named "default" containing the chosen default printer as its only
  2211.     # member. If there is already a printer called "default", we rename it.
  2212.  
  2213.     my $name = $config->{'queue'};
  2214.     my $printrc = load_ppr_printers_conf();
  2215.     my $printerfound = 0;
  2216.     for my $p (@{$printrc}) {
  2217.     if ($p->{'name'} eq $name) {
  2218.         $printerfound = 1;
  2219.     }
  2220.     # Rename a printer whose name is 'default'
  2221.     if ($p->{'name'} eq 'default') {
  2222.         # Search for a free name
  2223.         my $i = 0;
  2224.         my $namefound = 0;
  2225.         my $newname = "";
  2226.         while(!$namefound) {
  2227.         my $pp;
  2228.         my $nameinuse = 0;
  2229.         for $pp (@{$printrc}) {
  2230.             if (defined($pp->{'name'})) {
  2231.             if ($pp->{'name'} eq "default$i") {
  2232.                 $nameinuse = 1;
  2233.                 $i++;
  2234.                 last;
  2235.             }
  2236.             }
  2237.         }
  2238.         $namefound = 1 - $nameinuse;
  2239.         }
  2240.         $newname = "default$i";
  2241.         # If the printer we want to use as default printer has the
  2242.         # name "default", we must use the new name as the member name
  2243.         # in the default group.
  2244.         if ($name eq "default") {
  2245.         $name = $newname;
  2246.         }
  2247.         # Do the renaming
  2248.         # Copy the queue ...
  2249.         if (system("foomatic-configure -s ppr -n $newname -C default")){
  2250.         die "Could not copy the queue \"default\" into the " .
  2251.             "queue \"$newname\"!\n";
  2252.         }
  2253.         # ... and remove the original one
  2254.         if (system("foomatic-configure -s ppr -n default -R")) {
  2255.         die "Could not remove the queue \"default\"!\n";
  2256.         }
  2257.         warn "Renamed the printer\"default\" to \"$newname\"!\n";
  2258.     }
  2259.     }
  2260.  
  2261.     # The desired default printer exists? Then make it the default
  2262.     if ($printerfound) {
  2263.     # Create a group named "default" with only this printer as member
  2264.     my $ppad_group = "$sysdeps->{'ppr-ppad'} group members " .
  2265.         "default \"$name\"";
  2266.     if (system $ppad_group) {
  2267.         warn "Could not create a group to make the queue \"$name\" " .
  2268.         "the default!\n";
  2269.     }
  2270.     }
  2271.  
  2272. }
  2273.  
  2274. sub delete_ppr {
  2275.     my ($config) = $_[0];
  2276.  
  2277.     # This line deletes the old printer queue
  2278.     my $queuedeleteline = "$sysdeps->{'ppr-ppad'} delete " .
  2279.     "\"$config->{'queue'}\"";
  2280.  
  2281.     # Do it!
  2282.     system $queuedeleteline and
  2283.     die "Unable to delete queue \"$config->{'queue'}\"!\n";
  2284.  
  2285.     # Rename the PPD file
  2286.  
  2287.     # PPD file name
  2288.     my $ppdfile = sprintf('%s/ppr/%s.ppd',
  2289.               $sysdeps->{'foo-etc'},
  2290.               $config->{'queue'});
  2291.  
  2292.     # Rename old $ppdfile, if any
  2293.     rename "$ppdfile", "$ppdfile.old" 
  2294.     if (-f "$ppdfile");
  2295.  
  2296.     return 1;
  2297. }
  2298.  
  2299. sub query_ppr {
  2300.     my ($config) = @_;
  2301.  
  2302.     # User requests data of a printer/driver combo to see the options before
  2303.     # installing a queue
  2304.     if (($opt_P) && ((($config->{'driver'}) && ($config->{'printer'}) &&
  2305.     ($config->{'driver'} ne "raw")) || ($config->{'ppdfile'}))) {
  2306.     if ($opt_n) {
  2307.         my $olddatablob = load_ppr_datablob($opt_n);
  2308.         print_perl_combo_data($config, $olddatablob);
  2309.     } else {
  2310.         print_perl_combo_data($config);
  2311.     }
  2312.     return;
  2313.     }
  2314.  
  2315.     my $i = $ARGV[0];
  2316.     if (!defined($i)) {$i = 0;}
  2317.  
  2318.     my $pconf = load_ppr_printers_conf();
  2319.     if (defined($opt_r)) {$opt_r = undef;}
  2320.     my $p;
  2321.  
  2322.     if (!$opt_P) {
  2323.     print "<queues>\n";
  2324.     }
  2325.  
  2326.     # Query the default printer
  2327.     my $default;
  2328.     if (!defined($config->{'queue'})) {
  2329.     for $p (@{$pconf}) {
  2330.         if ($p->{'default'}) {
  2331.         $default = $p->{'name'};
  2332.         if (!$opt_P) {
  2333.             print "<defaultqueue>$p->{'name'}</defaultqueue>\n";
  2334.         }
  2335.         last;
  2336.         }
  2337.     }
  2338.     }
  2339.  
  2340.     for $p (@{$pconf}) {
  2341.     
  2342.     # were we invoked for only one queue?
  2343.     next if (defined($config->{'queue'})
  2344.          and $config->{'queue'} ne $p->{'name'});
  2345.  
  2346.     # load the queue data
  2347.     $db->{'dat'} = load_ppr_datablob($p->{'name'});
  2348.  
  2349.     # extract the queue data block
  2350.     my $c = $db->{'dat'}{'queuedata'};
  2351.         
  2352.     if ($opt_P) {
  2353.         if ($p->{'name'} eq $default) {
  2354.         $db->{'dat'}{'queuedata'}{'default'} = 1;
  2355.         } else {
  2356.         $db->{'dat'}{'queuedata'}{'default'} = 0;
  2357.         }
  2358.         $db->{'dat'}{'queuedata'}{'remote'} = 0;
  2359.         my $asciidata = $db->getascii();
  2360.         $asciidata =~ s/\$VAR1/\$QUEUES[$i]/g;
  2361.         print $asciidata;
  2362.         $i ++;
  2363.     } else {
  2364.         # and get it to standard output
  2365.         dump_config($c);
  2366.     }
  2367.     }
  2368.  
  2369.     if (!$opt_P) {
  2370.     print "</queues>\n";
  2371.     }
  2372.     
  2373.     return;
  2374. }
  2375.  
  2376. ### Queue manipulation functions for direct, spooler-less printing
  2377.  
  2378. sub setup_direct {
  2379.     my ($config) = $_[0];
  2380.  
  2381.     # Read the previous config file
  2382.     my $pconfig = load_direct_config();
  2383.  
  2384.     my ($entry, $reconf, $p);
  2385.     for $p (@{$pconfig}) {
  2386.     if ($p->{'name'} eq $config->{'queue'}) {
  2387.         $entry = $p;
  2388.         $reconf = 1;
  2389.         last;
  2390.  
  2391.         use Data::Dumper;
  2392.         print "Reconfigure of ", Dumper($p);
  2393.     }
  2394.     }
  2395.  
  2396.     # PPD file name
  2397.     my $ppdfile = sprintf('%s/direct/%s.ppd',
  2398.               $sysdeps->{'foo-etc'},
  2399.               $config->{'queue'});
  2400.  
  2401.     # Get the data from the former queue if we reconfigure or copy a queue
  2402.     # do also some checking of the user-supplied parameters
  2403.     my ($rawqueue, $newfoomaticdata, $makemodel) =
  2404.     getoldqueuedata($config, $reconf);
  2405.  
  2406.     # Set the printer queue name
  2407.     $entry->{'name'} = $config->{'queue'};
  2408.  
  2409.     # Use manufacturer and model as description when no description is
  2410.     # provided
  2411.     if (defined($config->{'desc'})) {
  2412.     $entry->{'desc'} = $config->{'desc'};
  2413.     } else {
  2414.     # Before we overwrite the description field with manufacturer
  2415.     # and model, check if there is some old contents
  2416.     my( $olddesc );
  2417.     if (($reconf) && ($entry->{'desc'})) {
  2418.         $olddesc = $entry->{'desc'};
  2419.     }
  2420.     if (!$olddesc) {
  2421.         $entry->{'desc'} = "$makemodel";
  2422.     }
  2423.     }
  2424.  
  2425.     # Fill in the "location" field if something for it is provided.
  2426.     if (defined($config->{'loc'})) {
  2427.     $entry->{'loc'} = $config->{'loc'};
  2428.     }
  2429.  
  2430.     # If the printing jobs should not be passed to standard output, put the
  2431.     # command line into $postpipe (for example for Socket, Samba, parallel
  2432.     # port ...)
  2433.     my $postpipe = "";
  2434.  
  2435.     if ((!$reconf) or ($config->{'connect'})) {
  2436.     # Set up connection type
  2437.  
  2438.     # All URIs ("-c" option) have the same syntax as URIs in CUPS ("-v"
  2439.     # option of "lpadmin").
  2440.     if ($config->{'connect'} =~ m!^(file|usb|parallel|serial):(.*)!) {
  2441.         # Local printer or printing to a file
  2442.         my $file = $2;
  2443.         if ($config->{'connect'} =~ m!^usb://!) {
  2444.         # Queue with printer-bound USB URI transferred from CUPS,
  2445.         # as spooler-less printing does not support these URIs, 
  2446.         # translate it back to a standard USB device URI
  2447.         $file = cups_usb_printer_uri_to_device_uri($file);
  2448.         }
  2449.         if (! -e $file) {
  2450.         warn "The device or file $file doesn't exist? " .
  2451.             "Working anyway.\n";
  2452.         }
  2453.         if (($file =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) ||
  2454.         ($file =~ m!^/dev/ptal-printd/(.+)$!) ||
  2455.         ($file =~ m!^/var/run/ptal-printd/(.+)$!)) {
  2456.         # Translate URI for ptal-printd to postpipe using the
  2457.         # "ptal-connect" command
  2458.         my $devname = $1;
  2459.         $devname =~ s/_/:/;
  2460.         $devname =~ s/_/:/;
  2461.         $postpipe = "$sysdeps->{'ptal-connect'} $devname -print";
  2462.         } else {
  2463.         $postpipe = "$sysdeps->{'cat'} > $file";
  2464.         }
  2465.     } elsif ($config->{'connect'} =~ m!^ptal://?([^/].*)$!) {
  2466.         # HPOJ MLC protocol
  2467.         my $devname = $1;
  2468.         $postpipe = "$sysdeps->{'ptal-connect'} $devname -print";
  2469.     } elsif ($config->{'connect'} =~ m!^mtink:/(.+)$!) {
  2470.         # Printing through "mtinkd"
  2471.         $postpipe = "$sysdeps->{'cat'} > $sysdeps->{'mtink-pipes'}/$1";
  2472.     } elsif ($config->{'connect'} =~ m!^lpd://([^/]+)/([^/]+)$!) {
  2473.         # Remote LPD
  2474.         my $remhost = $1;
  2475.         my $remqueue = $2;
  2476.         $postpipe = "$sysdeps->{'rlpr'} -q -h -P $remqueue\@$remhost";
  2477.     } elsif ($config->{'connect'} =~
  2478.          m!^socket://([^/:]+):([0-9]+)/?$!){
  2479.         # Socket (AppSocket/HP JetDirect)
  2480.         my $remhost = $1;
  2481.         my $remport = $2;
  2482.         $postpipe = "$sysdeps->{'nc'} -w 1 $remhost $remport";
  2483.     } elsif ($config->{'connect'} =~ m!^smb://(.*)$!) {
  2484.         # SMB (Printer on Windows server)
  2485.         my $parameters = $1;
  2486.         # Get the user's login and password from the URI
  2487.         my $smbuser = "";
  2488.         my $smbpassword = "";
  2489.         if ($parameters =~ m!([^@]*)@([^@]+)!) {
  2490.         my $login = $1;
  2491.         $parameters = $2;
  2492.         if ($login =~ m!([^:]*):([^:]*)!) {
  2493.             $smbuser = $1;
  2494.             $smbpassword = $2;
  2495.         } else {
  2496.             $smbuser = $login;
  2497.             $smbpassword = "";
  2498.         }
  2499.         } else {
  2500.         $smbuser = "GUEST";
  2501.         $smbpassword = "";
  2502.         }
  2503.         # Get the workgroup, server, and share name
  2504.         my $workgroup = "";
  2505.         my $smbserver = "";
  2506.         my $smbshare = "";
  2507.         if ($parameters =~ m!([^/]*)/([^/]+)/([^/]+)$!) {
  2508.         $workgroup = $1;
  2509.         $smbserver = $2;
  2510.         $smbshare = $3;
  2511.         } elsif ($parameters =~ m!([^/]+)/([^/]+)$!) {
  2512.         $workgroup = "";
  2513.         $smbserver = $1;
  2514.         $smbshare = $2;
  2515.         } else {
  2516.         die "The \"smb://\" URI must at least contain the " .
  2517.             "server name and the share name!\n";
  2518.         }
  2519.         # Set up the command line for printing on the SMB server
  2520.         $postpipe = "$sysdeps->{'smbclient'} \"//$smbserver/$smbshare\"";
  2521.         if ($smbpassword ne "") {
  2522.         warn("WARNING: smbclient password is visible in PPD file\n");
  2523.         $postpipe .= " $smbpassword";
  2524.         }
  2525.         if ($smbuser ne "") {$postpipe .= " -U $smbuser";}
  2526.         if ($workgroup ne "") {$postpipe .= " -W $workgroup";}
  2527.         $postpipe .= " -N -P -c 'print -' ";
  2528.     } elsif ($config->{'connect'} =~ m!^ncp://(.*)$!) {
  2529.         my $parameters = $1;
  2530.         # Get the user's login and password from the URI
  2531.         my $ncpuser = "";
  2532.         my $ncppassword = "";
  2533.         if ($parameters =~ m!([^@]*)@([^@]+)!) {
  2534.         my $login = $1;
  2535.         $parameters = $2;
  2536.         if ($login =~ m!([^:]*):([^:]*)!) {
  2537.             $ncpuser = $1;
  2538.             $ncppassword = $2;
  2539.         } else {
  2540.             $ncpuser = $login;
  2541.             $ncppassword = "";
  2542.         }
  2543.         } else {
  2544.         $ncpuser = "";
  2545.         $ncppassword = "";
  2546.         }
  2547.         # Get the server and share name
  2548.         my $ncpserver = "";
  2549.         my $ncpqueue = "";
  2550.         if ($parameters =~ m!([^/]+)/([^/]+)$!) {
  2551.         $ncpserver = $1;
  2552.         $ncpqueue = $2;
  2553.         } else {
  2554.         die "The \"ncp://\" URI must at least contain the server " .
  2555.             "name and the queue name!\n";
  2556.         }
  2557.         # Set up the command line for printing on the Netware server
  2558.         $postpipe = "$sysdeps->{'nprint'} -S $ncpserver";
  2559.         if ($ncpuser ne "") {
  2560.         $postpipe .= " -U $ncpuser";
  2561.         if ($ncppassword ne "") {
  2562.             warn("WARNING: ncp password is visible in PPD file\n");
  2563.             $postpipe .= " -P $ncppassword";
  2564.         } else {
  2565.             $postpipe .= " -n";
  2566.         }
  2567.         }
  2568.         $postpipe .= " -q $ncpqueue -N - 2>/dev/null";
  2569.     } elsif ($config->{'connect'} =~ m!^postpipe:(.*)$!) {
  2570.         # Pipe output into a command
  2571.         $postpipe = $1;
  2572.     } elsif ($config->{'connect'} =~ m!^stdout!) {
  2573.         $postpipe = "";
  2574.     } elsif ($config->{'connect'}) {
  2575.         die ("The URI \"$config->{'connect'}\" is not supported for " .
  2576.          "spooler-less printing or you have\nmistyped.\n");
  2577.     } else {
  2578.         die "You must specify a connection with -c.\n";
  2579.     }
  2580.     # Put $postpipe into the data structure, so that it will be
  2581.     # inserted into the PPD file
  2582.     if ($postpipe ne "") {
  2583.         $postpipe = "| $postpipe";
  2584.         $db->{'dat'}{'postpipe'} = $postpipe;
  2585.     } else {
  2586.         undef $db->{'dat'}{'postpipe'};
  2587.     }
  2588.     } else {
  2589.     # Keep previous connection type
  2590.     # Use previous $postpipe
  2591.     if (defined($db->{'dat'}{'postpipe'})) {
  2592.         $postpipe = $db->{'dat'}{'postpipe'};
  2593.     }
  2594.     }
  2595.  
  2596.     # Various file setup
  2597.     mkdir $sysdeps->{'foo-etc'}, 0755;
  2598.     mkdir $sysdeps->{'foo-etc'} . "/direct", 0755;
  2599.  
  2600.     # Add to the config file if a new entry
  2601.     if (!$reconf) {
  2602.     push(@{$pconfig}, $entry);
  2603.     }
  2604.  
  2605.     # Generate/write the PPD file
  2606.     writeppdfile($config, $ppdfile, $rawqueue, $newfoomaticdata);
  2607.  
  2608.     # Write back /etc/foomatic/direct/.config
  2609.     my $pconfigname = $sysdeps->{'direct-config'};
  2610.     rename $pconfigname, "$pconfigname.old";
  2611.     open PCONFIG, "> $pconfigname" or die "Cannot write $pconfigname!\n";
  2612.     print PCONFIG dump_direct_config($pconfig);
  2613.     close PCONFIG;
  2614.     chmod 0644, $pconfigname;
  2615.  
  2616.     return 1;
  2617. }
  2618.  
  2619. sub default_direct {
  2620.     my ($config) = $_[0];
  2621.  
  2622.     my $name = $config->{'queue'};
  2623.  
  2624.     my $pconfig = load_direct_config();
  2625.  
  2626.     # Modify the "default" fields of the printers appropriately
  2627.  
  2628.     for (@{$pconfig}) {
  2629.     $_->{'default'} = ($_->{'name'} eq $name);
  2630.     }
  2631.  
  2632.     my @newpconfig = dump_direct_config($pconfig);
  2633.  
  2634.     my $pconfigname = $sysdeps->{'direct-config'};
  2635.     rename $pconfigname, "$pconfigname.old";
  2636.     open PCONFIG, "> $pconfigname" or die "Cannot write $pconfigname!\n";
  2637.     print PCONFIG @newpconfig;
  2638.     close PCONFIG;
  2639.     chmod 0644, $pconfigname;
  2640.  
  2641.     return 1;
  2642. }
  2643.  
  2644. sub delete_direct {
  2645.     my ($config) = $_[0];
  2646.  
  2647.     my $name = $config->{'queue'};
  2648.  
  2649.     my $pconfig = load_direct_config();
  2650.  
  2651.     # Overtake all entries except the one of the deleted printer to the
  2652.     # new config file
  2653.  
  2654.     my @newconf;
  2655.     for (@{$pconfig}) {
  2656.     push (@newconf, $_)
  2657.         unless ($_->{'name'} eq $name);
  2658.     }
  2659.  
  2660.     my @newpconfig = dump_direct_config(\@newconf);
  2661.  
  2662.     my $pconfigname = $sysdeps->{'direct-config'};
  2663.     rename $pconfigname, "$pconfigname.old";
  2664.     open PCONFIG, "> $pconfigname" or die "Cannot write $pconfigname!\n";
  2665.     print PCONFIG @newpconfig;
  2666.     close PCONFIG;
  2667.     chmod 0644, $pconfigname;
  2668.  
  2669.     # PPD file name
  2670.     my $ppdfile = sprintf('%s/direct/%s.ppd',
  2671.               $sysdeps->{'foo-etc'},
  2672.               $config->{'queue'});
  2673.  
  2674.     # Rename old $ppdfile, if any
  2675.     rename $ppdfile, "$ppdfile.old" 
  2676.     if (-f $ppdfile);
  2677.  
  2678.     return 1;
  2679. }
  2680.  
  2681. sub query_direct {
  2682.     my ($config) = @_;
  2683.  
  2684.     # User requests data of a printer/driver combo to see the options before
  2685.     # installing a queue
  2686.     if (($opt_P) && ((($config->{'driver'}) && ($config->{'printer'}) &&
  2687.     ($config->{'driver'} ne "raw")) || ($config->{'ppdfile'}))) {
  2688.     if ($opt_n) {
  2689.         my $olddatablob = load_direct_datablob($opt_n);
  2690.         print_perl_combo_data($config, $olddatablob);
  2691.     } else {
  2692.         print_perl_combo_data($config);
  2693.     }
  2694.     return;
  2695.     }
  2696.  
  2697.     my $i = $ARGV[0];
  2698.     if (!defined($i)) {$i = 0;}
  2699.  
  2700.     my $pconf = load_direct_config();
  2701.     if (defined($opt_r)) {$opt_r = undef;}
  2702.     my $p;
  2703.  
  2704.     if (!$opt_P) {
  2705.     print "<queues>\n";
  2706.     }
  2707.  
  2708.     # Query the default printer
  2709.     my $default;
  2710.     if (!defined($config->{'queue'})) {
  2711.     for $p (@{$pconf}) {
  2712.         if ($p->{'default'}) {
  2713.         $default = $p->{'name'};
  2714.         if (!$opt_P) {
  2715.             print "<defaultqueue>$p->{'name'}</defaultqueue>\n";
  2716.         }
  2717.         last;
  2718.         }
  2719.     }
  2720.     }
  2721.  
  2722.     for $p (@{$pconf}) {
  2723.     
  2724.     # were we invoked for only one queue?
  2725.     next if (defined($config->{'queue'})
  2726.          and $config->{'queue'} ne $p->{'name'});
  2727.  
  2728.     # load the queue data
  2729.     $db->{'dat'} = load_direct_datablob($p->{'name'});
  2730.  
  2731.     # extract the queue data block
  2732.     my $c = $db->{'dat'}{'queuedata'};
  2733.         
  2734.     if ($opt_P) {
  2735.         if ($p->{'name'} eq $default) {
  2736.         $db->{'dat'}{'queuedata'}{'default'} = 1;
  2737.         } else {
  2738.         $db->{'dat'}{'queuedata'}{'default'} = 0;
  2739.         }
  2740.         $db->{'dat'}{'queuedata'}{'remote'} = 0;
  2741.         my $asciidata = $db->getascii();
  2742.         $asciidata =~ s/\$VAR1/\$QUEUES[$i]/g;
  2743.         print $asciidata;
  2744.         $i ++;
  2745.     } else {
  2746.         # and get it to standard output
  2747.         dump_config($c);
  2748.     }
  2749.     }
  2750.  
  2751.     if (!$opt_P) {
  2752.     print "</queues>\n";
  2753.     }
  2754.     
  2755.     return;
  2756. }
  2757.  
  2758. ### Functions used by the queue manipulation functions from above
  2759.  
  2760. sub dump_config {
  2761.     my $c = $_[0];
  2762.  
  2763.     print 
  2764.     sprintf("<queue foomatic=\"%d\" spooler=\"%s\">\n", 
  2765.         ($c->{'foomatic'} ? 1 : 0),
  2766.         $c->{'spooler'}),
  2767.  
  2768.     _tag('name',$c->{'queue'}),
  2769.     _tag('printer',$c->{'printer'}),
  2770.     _tag('driver',$c->{'driver'}),
  2771.     _tag('connect',$c->{'connect'}),
  2772.     _tag('location',$c->{'loc'}),
  2773.     _tag('description',$c->{'desc'}),
  2774.     ($c->{'spooler'} eq "cups" ?
  2775.      (_tag('dontdisable',$c->{'dd'}),
  2776.       _tag('attempts',$c->{'att'}),
  2777.       _tag('delay',$c->{'delay'}),
  2778.       (defined($c->{'quotaperiod'}) ?
  2779.        _tag('quotaperiod',$c->{'quotaperiod'}) : ()),
  2780.       (defined($c->{'pagelimit'}) ?
  2781.        _tag('pagelimit',$c->{'pagelimit'}) : ()),
  2782.       (defined($c->{'klimit'}) ?
  2783.        _tag('klimit',$c->{'klimit'}) : ()),
  2784.       (defined($c->{'laststatechange'}) ?
  2785.        _tag('laststatechange',$c->{'laststatechange'}) : ()),
  2786.       (defined($c->{'shared'}) ?
  2787.        _tag('shared',$c->{'shared'}) : ()),
  2788.       (defined($c->{'operationpolicy'}) ?
  2789.        _tag('operationpolicy',$c->{'operationpolicy'}) : ()),
  2790.       (defined($c->{'errorpolicy'}) ?
  2791.        _tag('errorpolicy',$c->{'errorpolicy'}) : ())) : ()),
  2792.     "</queue>\n";
  2793.     
  2794.     return;
  2795. }
  2796.  
  2797. sub _tag {
  2798.     my ($t, $v) = @_;
  2799.  
  2800.     return '' if !defined($v);
  2801.  
  2802.     $v =~ s!\&!\&\;!g;
  2803.     $v =~ s!\<!\<\;!g;
  2804.  
  2805.     return "  <$t>$v</$t>\n";
  2806. }
  2807.  
  2808. sub dump_lpd_printcap {
  2809.     my ($config, $pcap )= @_;
  2810.  
  2811.     my @retval;
  2812.  
  2813.     my $item;
  2814.     my $backslash = "\\";
  2815.     $backslash = "" if $config->{'spooler'} eq 'lprng';
  2816.     for $item (@{$pcap}) {
  2817.     for (@{$item->{'comments'}}) {
  2818.         push (@retval, "$_\n");
  2819.     }
  2820.     if (defined($item->{'names'})) {
  2821.         map { $_ = '' if not defined $_; } @{$item->{'names'}};
  2822.         push (@retval, (join('|', @{$item->{'names'}}) . ":${backslash}\n"));
  2823.     }
  2824.     for (keys(%{$item->{'str'}})) {
  2825.         # special case of 'tc' items, as there can be more than one
  2826.         if ($_ =~ /^tc\d+$/) {
  2827.         push (@retval, 
  2828.               sprintf("    :tc=%s:${backslash}\n", $item->{'str'}{$_}));
  2829.         } else {
  2830.         push (@retval, 
  2831.               sprintf("    :$_=%s:${backslash}\n", $item->{'str'}{$_}));
  2832.         }
  2833.     }
  2834.     for (keys(%{$item->{'bool'}})) {
  2835.         if ($item->{'bool'}{$_}) {
  2836.         push (@retval, "    :$_:${backslash}\n");
  2837.         }
  2838.     }
  2839.     for (keys(%{$item->{'num'}})) {
  2840.         push (@retval, 
  2841.           sprintf("    :$_#%s:${backslash}\n", $item->{'num'}{$_}));
  2842.     }
  2843.     if( $backslash ){
  2844.     my $lastline = pop(@retval);
  2845.         $lastline =~ s!:\\!:!;
  2846.     push (@retval, $lastline);
  2847.     }
  2848.     }
  2849.     print "PRINTCAP (spooler '" . $config->{'spooler'} . "') " . Dumper(\@retval) . "\n" if $debug;
  2850.  
  2851.     return @retval;
  2852. }
  2853.  
  2854. sub load_lpd_printcap {
  2855.  
  2856.     # list-o-printers, each with comments
  2857.  
  2858.     open PCAP, $sysdeps->{'lpd-pcap'} or die "Cannot read printcap file!\n";
  2859.     my $pcap = join('', <PCAP>);
  2860.     close PCAP;
  2861.     print "PC '$pcap'\n" if $debug;
  2862.  
  2863. #    die( "Cannot currently parse lprng style printcaps created by " .
  2864. #     "lprngtool!\n" .
  2865. #     "See the BUGS section in the manpage for details.\n")
  2866. #      if $pcap =~ m/\n\s*(:.*[^\\]\n\s*:)/m;
  2867.  
  2868.     # watch out for comments with \ at end of line - ignore \
  2869.     $pcap =~ s!^(\s*\#.*\\)$!${1}MEMEMEM!gm;
  2870.     # now we join lines with \ at end
  2871.     $pcap =~ s!\\\n!!gms;
  2872.     # remove \ in comment lines
  2873.     $pcap =~ s!\\MEMEMEM!\\!g;
  2874.     print "AFTER '$pcap'\n" if $debug;
  2875.  
  2876.     my (@comment, @items, @comments_in_pc_entry);
  2877.  
  2878.     my ($pline, $pcentry);
  2879.     $pcentry = "";
  2880.     for $pline (split('\n',$pcap)) {
  2881.     $pline =~ s/^\s+//;
  2882.     print "LINE '$pline', pcentry '$pcentry'\n" if $debug;
  2883.     next if $pline eq "";
  2884.     if ($pline =~ m!^\#!) {
  2885.         if( $pcentry ){
  2886.             push (@comments_in_pc_entry, $pline);
  2887.         } else {
  2888.         push (@comment, $pline);
  2889.         }
  2890.     } elsif ($pline =~ m!^:!) {
  2891.         push( @comment, @comments_in_pc_entry );
  2892.         @comments_in_pc_entry = ();
  2893.         if( $pcentry ne "" ){
  2894.         $pcentry .= $pline;
  2895.     } else {
  2896.         die( "bad printcap entry at '$pline'" );
  2897.         }
  2898.     } elsif( $pcentry ne "" ){
  2899.         push (@items, { 'itemstr' => $pcentry,
  2900.                 'comments' => [ @comment ] });
  2901.         @comment = @comments_in_pc_entry;
  2902.         @comments_in_pc_entry = ();
  2903.         $pcentry = $pline;
  2904.     } else {
  2905.         $pcentry = $pline;
  2906.     }    
  2907.     }
  2908.     if( $pcentry ){
  2909.         push( @comment, @comments_in_pc_entry );
  2910.         @comments_in_pc_entry = ();
  2911.         push (@items, { 'itemstr' => $pcentry,
  2912.                 'comments' => [ @comment ] });
  2913.         @comment = ();
  2914.     }
  2915.     # Trailing comments get stuck on as empty item later...
  2916.     print "Printcap:\n" . Dumper(\@items ) if $debug;
  2917.  
  2918.     my $p;
  2919.     for $p (@items) {
  2920.     my $item;
  2921.     my $first = 1;
  2922.     my $tci = 0;
  2923.     for $item (split(/:\s*/, $p->{'itemstr'})) {
  2924.         next if $item =~ m!^\s*$!;
  2925.         if ($first) {
  2926.         my $name;
  2927.         for $name (split('\|',$item)) {
  2928.             $name =~ s!\s*(.+)\s*!$1!;
  2929.             push (@{$p->{'names'}}, $name);
  2930.         }
  2931.         $first = 0;
  2932.         } else {
  2933.         if ($item =~ m!^([^=]*)=(.+)!) {
  2934.             # special case of 'tc' items, as there can be more 
  2935.             # than one
  2936.             if ($1 eq 'tc') { $p->{'str'}{"tc$tci"} = $2; $tci++; }
  2937.             else { $p->{'str'}{$1} = $2; }
  2938.         } elsif ($item =~ m!^([^\#]*)\#(.+)!) {
  2939.             $p->{'num'}{$1} = $2;
  2940.         } elsif ($item =~ m!^([^\@]*)\@?!) {
  2941.             $p->{'bool'}{$1} = 1;
  2942.         }
  2943.         }
  2944.     }
  2945.     }
  2946.  
  2947.     # Trailing comments from way above...
  2948.     if (scalar(@comment)) {
  2949.     push (@items, {'comments' => [ @comment ]});
  2950.     }
  2951.  
  2952.     return \@items;
  2953. }
  2954.  
  2955. sub load_cups_printersconf {
  2956.  
  2957.     # list-o-printers
  2958.     my @items = ();
  2959.     my $itemshash = {};
  2960.     
  2961.     if ($< == 0) {
  2962.     # Get info from /etc/cups/printers.conf, works only as "root" and
  2963.     # with locally defined printers
  2964.     my @pconf = ();
  2965.     if (open PCONF, $sysdeps->{'cups-pconf'}) {
  2966.         @pconf = <PCONF>;
  2967.     close PCONF;
  2968.     }
  2969.     
  2970.     my $line;
  2971.     my $p = {};
  2972.     my $linecount = 0;
  2973.     for $line (@pconf) {
  2974.         $linecount ++;
  2975.         if (!($line =~ m!^\s*\#!) && (!($line =~ m!^\s*$!))) {
  2976.         if ($line =~ m!^\s*<(.*)Printer\s+([^\s>]+)>\s*$!) {
  2977.             # Beginning of new <Printer ...> block
  2978.             $p->{'name'} = $2;
  2979.             $p->{'default'} = ($1 eq "Default");
  2980.         } elsif ($line =~ m!^\s*</Printer>\s*$!) {
  2981.             # End of <Printer ...> block
  2982.             push (@items, $p);
  2983.             $itemshash->{$p->{name}} = $#items;
  2984.             $p = {};
  2985.         } elsif (defined($p->{'name'})) {
  2986.             # Inside <Printer ...> block
  2987.             if (($line =~ m!^\s*(\S+)\s+(\S.*)$!) and
  2988.             ($1 ne '')) {$p->{$1} = $2};
  2989.         } else {
  2990.             # Outside <Printer ...> block
  2991.             die "Line $linecount in $sysdeps->{'cups-pconf'} " .
  2992.             "invalid!\n";
  2993.         }
  2994.         }    
  2995.     }
  2996.     }
  2997.     if (($< != 0) || (($opt_r) && (($opt_Q) || ($opt_P)))) {
  2998.     # Get info with the "lpstat" command, works for normal users and for
  2999.     # remote printers.
  3000.     open LPSTAT, "$sysdeps->{'cups-lpstat'} -l -d -p -v |" or 
  3001.         die "Cannot execute \"lpstat\".\n";
  3002.     my @lpstat = <LPSTAT>;
  3003.     close LPSTAT;
  3004.     
  3005.     my $line;
  3006.     my $linecount = 0;
  3007.     my $defaultprinter = '';
  3008.     my $currentitem = -1;
  3009.     for $line (@lpstat) {
  3010.         chomp ($line);
  3011.         $linecount ++;
  3012.         if (!($line =~ m!^\s*$!)) {
  3013.         if ($line =~
  3014.             m!^\s*system\s+default\s+destination:\s+(\S+)\s*$!) {
  3015.             # Default printer
  3016.             $defaultprinter = $1;
  3017.         } elsif ($line =~ m!^printer\s+(\S+)\s+(\S.*)$!) {
  3018.             # Beginning of new printer's entry
  3019.             my $name = $1;
  3020.             my $state = $2;
  3021.             $state =~ s/\s+-$//;
  3022.             if (!defined($itemshash->{$name})) {
  3023.             push(@items, {});
  3024.             $itemshash->{$name} = $#items;
  3025.             # If we are root and didn't see this entry
  3026.             # in /etc/cups/printers.conf, this printer
  3027.             # is remotely defined
  3028.             if ($< == 0) {
  3029.                 $items[$itemshash->{$name}]{'remote'} = 1;
  3030.             }
  3031.             }
  3032.             $currentitem = $itemshash->{$name};
  3033.             $items[$currentitem]{'name'} ||= $name;
  3034.             $items[$currentitem]{'State'} ||= $state;
  3035.             $items[$currentitem]{'default'} = 
  3036.             ($name eq $defaultprinter);
  3037.         } elsif ($line =~ m!^\s+Description:\s+(\S.*)$!) {
  3038.             # Description field
  3039.             if ($currentitem != -1) {
  3040.             $items[$currentitem]{'Info'} ||= $1;
  3041.             }
  3042.         } elsif ($line =~ m!^\s+Location:\s+(\S.*)$!) {
  3043.             # Location field
  3044.             if ($currentitem != -1) {
  3045.             $items[$currentitem]{'Location'} ||= $1;
  3046.             }
  3047.         } elsif ($line =~ m!^\s+Connection:\s+remote!) {
  3048.             # Remote printer, only keep it when the "-r" option is
  3049.             # given
  3050.             if (!$opt_r) {
  3051.             # "delete" does not work on arrays with Perl 5.0.x
  3052.             # Thanks to Olaf Till (i7tiol@t-online.de) who 
  3053.             # contributed this fix
  3054.             splice(@items, $currentitem, 1);
  3055.             #delete($items[$currentitem]);
  3056.             $currentitem = -1;
  3057.             } else {
  3058.             if ($currentitem != -1) {
  3059.                 $items[$currentitem]{'remote'} = 1;
  3060.             }
  3061.             }
  3062.         } elsif ($line =~ m!^device\s+for\s+(\S+):\s+(\S.*)$!) {
  3063.             # "device for ..." line, extract URI
  3064.             my $name = $1;
  3065.             my $uri = $2;
  3066.             if (defined($itemshash->{$name})) {
  3067.             if ($uri !~ /:/) {$uri = "file:" . $uri};
  3068.             $currentitem = $itemshash->{$name};
  3069.             if (($currentitem <= $#items) &&
  3070.                 ($items[$currentitem]{'name'} eq $name)) {
  3071.                 $items[$currentitem]{'DeviceURI'} ||= $uri;
  3072.             }
  3073.             }
  3074.         }
  3075.         }
  3076.     }
  3077.     }
  3078.  
  3079.     return \@items;
  3080. }
  3081.  
  3082. sub dump_pdq_printrc {
  3083.     my $printrc = $_[0];
  3084.  
  3085.     my @retval;
  3086.  
  3087.     my $item;
  3088.     for $item (@{$printrc}) {
  3089.     if (defined($item->{'name'})) {
  3090.         # $item is a "printer" block
  3091.         push (@retval, "printer \"$item->{'name'}\" \{\n");
  3092.         for my $key (keys(%{$item})) {
  3093.         if (($key ne 'name') && ($key ne 'others')) {
  3094.             push (@retval, "\t$key $item->{$key}\n");
  3095.         }
  3096.         }
  3097.         push (@retval, "\}\n");
  3098.     } elsif (defined($item->{'others'})) {
  3099.         # $item is not a "printer" block
  3100.         push (@retval, $item->{'others'});
  3101.     }
  3102.     }
  3103.  
  3104.     # Check whether there is a already a 'try_include "/etc/foomatic/pdq/*"'
  3105.     # line in the config file
  3106.     if (!(join("", @retval) =~
  3107.       m!^\s*try_include\s*\"$sysdeps->{'foo-etc'}/pdq/driverdescr/\*\"\s*$!m)) {
  3108.     splice(@retval,0,0,"# Line inserted by $progname\ntry_include " .
  3109.            "\"$sysdeps->{'foo-etc'}/pdq/driverdescr/*\"\n\n");
  3110.     }
  3111.  
  3112.     # De-activate old line from Foomatic 2.0.x
  3113.     ($_ =~ s!^\s*try_include\s*\"$sysdeps->{'foo-etc'}/pdq/\*\"\s*$!\#$&!m)
  3114.     foreach @retval;
  3115.  
  3116.     return @retval;
  3117. }
  3118.  
  3119. sub load_pdq_printrc {
  3120.  
  3121.     # list-o-printers, with storage of non-printer-specific lines
  3122.  
  3123.     open PRINTRC, $sysdeps->{'pdq-printrc'} or 
  3124.     die "Cannot read printrc file!\n";
  3125.     my @printrc = <PRINTRC>;
  3126.     close PRINTRC;
  3127.  
  3128.     my @items;
  3129.     my @others;
  3130.     my $line;
  3131.     my $p;
  3132.     my $linecount = 0;
  3133.     my $inprinterblock = 0;
  3134.     my $nonprinterlines = 0;
  3135.     for $line (@printrc) {
  3136.     $linecount ++;
  3137.     if ($line =~ m!^\s*printer\s+\"(.+)\"\s*{\s*$!) {
  3138.         if ($inprinterblock == 1) {
  3139.         die "New printer block started without previous one " .
  3140.             "being closed!\nLine $linecount in " .
  3141.             "$sysdeps->{'pdq-printrc'}.\n";
  3142.         }
  3143.         # Beginning of new "printer" block
  3144.         # Store all non-printer-block stuff at first
  3145.         if ($nonprinterlines == 1) {
  3146.         push (@items, {'others' => join ("", @others )});
  3147.         $nonprinterlines = 0;
  3148.         @others = ();
  3149.         }
  3150.         # Read printer block name
  3151.         $inprinterblock = 1;
  3152.         $p->{'name'} = $1;
  3153.     } elsif ($inprinterblock == 1) {
  3154.         # Inside "printer" block
  3155.         if ($line =~ m!^\s*}\s*$!) {
  3156.         # End of "printer" block
  3157.         $inprinterblock = 0;
  3158.         push (@items, $p);
  3159.         $p = {};
  3160.         } elsif ($line =~ m!^\s*(\S+)\s*(\S+.*)$!) {
  3161.         $p->{$1} = $2;
  3162.         } elsif ((!($line =~ m!^\s*\#!)) && 
  3163.              (!($line =~ m!^\s*$!))) {
  3164.         die "Line $linecount in $sysdeps->{'pdq-printrc'} " .
  3165.             "invalid!\n";
  3166.         }
  3167.     } else {
  3168.         # Outside "printer" block
  3169.         push(@others, $line);
  3170.         $nonprinterlines = 1;
  3171.     }
  3172.     }
  3173.     # Trailing non-printer lines get stuck on as empty item
  3174.     if ($nonprinterlines == 1) {
  3175.     my $lines = join ("", @others);
  3176.     # Make sure that the last line line ends with a newline character
  3177.     if (!($lines =~ m!\n$!s)) {$lines .= "\n";}
  3178.     push (@items, {'others' => $lines});
  3179.     }
  3180.  
  3181.     return \@items;
  3182. }
  3183.  
  3184. sub load_ppr_printers_conf {
  3185.  
  3186.     # Check whether there is a group named "default" to see what is the
  3187.     # default printer.
  3188.     
  3189.     my $defaultfromgroup = "  ";
  3190.     if (open SHOWDEFAULTGROUP,
  3191.     "$sysdeps->{'ppr-ppad'} group show default 2>/dev/null |"){
  3192.     for my $line (<SHOWDEFAULTGROUP>) {
  3193.         chomp $line;
  3194.         if ($line =~ /\s*Members:\s*([^\s,]+)\s*$/) {
  3195.         $defaultfromgroup = $1;
  3196.         last;
  3197.         }
  3198.     }
  3199.     close SHOWDEFAULTGROUP;
  3200.     }
  3201.  
  3202.     # list-o-printers
  3203.     my @items = ();
  3204.     my $itemshash = {};
  3205.     
  3206.     if ($< == 0) {
  3207.     # Get info from /etc/ppr/printers/<queue name>, works only as
  3208.     # "root"
  3209.     opendir PCONFDIR, "$sysdeps->{'ppr-etc'}/printers" or
  3210.         die "Cannot read $sysdeps->{'ppr-etc'}/printers directory!\n";
  3211.     my $name;
  3212.     while ($name = readdir(PCONFDIR)) {
  3213.         # Do not consider "." and ".." as a printer queue
  3214.         next if ($name =~ /^\./);
  3215.         my $line;
  3216.         my $p = {};
  3217.         $p->{'name'} = $name;
  3218.         $p->{'default'} = (($name eq "default") ||
  3219.                    ($name eq $defaultfromgroup));
  3220.         @{$p->{'Bins'}} = ();
  3221.         my $linecount = 0;
  3222.         open PCONFFILE, "$sysdeps->{'ppr-etc'}/printers/$name" or
  3223.         die "Cannot read $sysdeps->{'ppr-etc'}/printers/$name!\n";
  3224.         for my $line (<PCONFFILE>) {
  3225.         chomp $line;
  3226.         $linecount ++;
  3227.         if (!($line =~ m!^\s*\#!) && (!($line =~ m!^\s*$!))) {
  3228.             if (($line =~ m!^\s*([^\s:]+)\s*:\s*(\S.*)$!) ||
  3229.             ($line =~ m!^\s*([^\s:]+)\s*:\s*()$!)) {
  3230.             # <keyword>: <value1> <value2> ...
  3231.             my $keyword = $1;
  3232.             my $values = $2;
  3233.             if (($values) && ($values ne "")) {
  3234.                 # If the value is enclosed in double quotes,
  3235.                 # remove the quotes
  3236.                 $values =~ s/^\"(.*)\"$/$1/;
  3237.                 if ($keyword eq "Bin") {
  3238.                 push (@{$p->{'Bins'}}, $values);
  3239.                 } else {
  3240.                 $p->{$keyword} = $values;
  3241.                 }
  3242.             }
  3243.             } else {
  3244.             warn "Line $linecount in " .
  3245.                 "$sysdeps->{'ppr-etc'}/printers/$name " .
  3246.                 "corrupted:\n    $line\n";
  3247.             }
  3248.         }
  3249.         }
  3250.         close PCONFFILE;
  3251.         push (@items, $p);
  3252.         $itemshash->{$p->{'name'}} = $#items;
  3253.     }
  3254.     }
  3255.     if ($< != 0) {
  3256.     # Get info with the "ppop"/"ppad" commands, works for normal users,
  3257.     # but needs installed and running PPR printing system
  3258.     open PPOP_DEST, "$sysdeps->{'ppr-ppop'} destination all |" or 
  3259.         die "Cannot execute \"ppop\".\n";
  3260.     my @ppop_dest = <PPOP_DEST>;
  3261.     close PPOP_DEST;
  3262.     
  3263.     my $line;
  3264.     my $linecount = 0;
  3265.     my $currentitem = -1;
  3266.     for $line (@ppop_dest) {
  3267.         chomp ($line);
  3268.         $linecount ++;
  3269.         if (($line !~ m!^\s*-+\s*$!) && 
  3270.         ($line !~ m!^\s*Destination\s+Type\s+Status\s+Charge\s*$!)){
  3271.         if ($line =~ m!^\s*(\S+)\s+printer!) {
  3272.             my $name = $1;
  3273.             open PPAD_SHOW,"$sysdeps->{'ppr-ppad'} show $name |" or 
  3274.             die "Cannot execute \"ppad\".\n";
  3275.             my $lcount = 0;
  3276.             if (!defined($itemshash->{$name})) {
  3277.             push(@items, {});
  3278.             $itemshash->{$name} = $#items;
  3279.             #print Dumper($itemshash);
  3280.             }
  3281.             $currentitem = $itemshash->{$name};
  3282.             $items[$currentitem]{'name'} ||= $name;
  3283.             $items[$currentitem]{'default'} = 
  3284.             (($name eq "default") ||
  3285.              ($name eq $defaultfromgroup));
  3286.             for my $line (<PPAD_SHOW>) {
  3287.             chomp $line;
  3288.             $lcount ++;
  3289.             if ((!($line =~ m!^\s*\#!)) && 
  3290.                 (!($line =~ m!^\s*$!))) {
  3291.                 if ($line =~ 
  3292.                 m!^\s*([^\s:][^:]*)\s*:\s*(.*)$!) {
  3293.                 # <keyword>: <value1> <value2> ...
  3294.                 my $keyword = $1;
  3295.                 my $values = $2;
  3296.                 if (($values) && ($values ne "")) {
  3297.                     # If the value is enclosed in double 
  3298.                     # quotes, remove the quotes
  3299.                     $values =~ s/^\"(.*)\"$/$1/;
  3300.                     if ($keyword eq "Bins") {
  3301.                     @{$items[$currentitem]{'Bins'}} = 
  3302.                         split(", ", $values);
  3303.                     } else {
  3304.                     if ($keyword eq "Switchset") {
  3305.                         $values =~ s/ -(\S) /\|$1/g;
  3306.                         $values =~ s/-(\S) /$1/g;
  3307.                         $values =~ s/\'//g;
  3308.                         $values =~ s/^|//g;
  3309.                     }
  3310.                     $items[$currentitem]{$keyword} = 
  3311.                         $values;
  3312.                     }
  3313.                 }
  3314.                 } else {
  3315.                 warn "Line $lcount in \"ppad show " .
  3316.                     "$name\" corrupted:\n    $line\n";
  3317.                 }
  3318.             }
  3319.             }
  3320.             close PPAD_SHOW;
  3321.         }
  3322.         }
  3323.     }
  3324.     }
  3325.  
  3326.     return \@items;
  3327. }
  3328.  
  3329. sub dump_direct_config {
  3330.     my $config = $_[0];
  3331.  
  3332.     my @retval;
  3333.  
  3334.     my $defaultprinter = undef;
  3335.     my $item;
  3336.     for $item (@{$config}) {
  3337.     if (defined($item->{'name'})) {
  3338.         if (defined($item->{'desc'})) {
  3339.         push (@retval, "$item->{'name'} desc:$item->{'desc'}\n");
  3340.         }
  3341.         if (defined($item->{'loc'})) {
  3342.         push (@retval, "$item->{'name'} loc:$item->{'loc'}\n");
  3343.         }
  3344.         if ($item->{'default'}) {
  3345.         $defaultprinter = $item->{'name'};
  3346.         }
  3347.     }
  3348.     }
  3349.     if (defined($defaultprinter)) {
  3350.     unshift(@retval, "default: $defaultprinter\n");
  3351.     }
  3352.     
  3353.     return @retval;
  3354. }
  3355.  
  3356. sub load_direct_config {
  3357.  
  3358.     # list-o-printers
  3359.     my @items = ();
  3360.     my $itemshash = {};
  3361.     
  3362.     # Configured printers are represented by PPD files in /etc/foomatic/
  3363.     opendir PCONFDIR, "$sysdeps->{'foo-etc'}/direct" or
  3364.     die "Cannot read $sysdeps->{'foo-etc'}/direct directory!\n";
  3365.     my $name;
  3366.     while ($name = readdir(PCONFDIR)) {
  3367.     # Files beginning with a dot or ending with a tilde are never
  3368.     # printers
  3369.     next if (($name =~ /^\./) || ($name =~ /~$/));
  3370.     # Only ".ppd" files are printer descriptions.
  3371.     next unless ($name =~ /\.ppd$/i);
  3372.     $name =~ s/\.ppd$//i;
  3373.     # Do not make two entries when there is both a ".ppd" AND ".PPD"
  3374.     # file for the same printer name.
  3375.     next if (defined($itemshash->{$name}));
  3376.     my $p = {};
  3377.     $p->{'name'} = $name;
  3378.     push (@items, $p);
  3379.     $itemshash->{$p->{'name'}} = $#items;
  3380.     }
  3381.  
  3382.     # Get additional info from /etc/foomatic/direct/.config (default
  3383.     # printer, description, location
  3384.     if (open CONFIG, "< $sysdeps->{'direct-config'}") {
  3385.     while (my $line = <CONFIG>) {
  3386.         chomp $line;
  3387.         if ($line =~ /^default\s*:\s*([^:\s]+)\s*$/) {
  3388.         my $currentitem = $itemshash->{$1};
  3389.         $items[$currentitem]{'default'} = 1;
  3390.         } elsif ($line =~ /^\s*([^:\s]+)\s+([^:\s]+)\s*:(.*)$/) {
  3391.         my $currentitem = $itemshash->{$1};
  3392.         $items[$currentitem]{$2} = $3;
  3393.         }
  3394.     }
  3395.     close CONFIG;
  3396.     }
  3397.  
  3398.     return \@items;
  3399. }
  3400.  
  3401. sub cups_correct_ptal_uri {
  3402.  
  3403.     # HPOJ 0.9 uses "ptal:..." URIs with one slash
  3404.     # ("ptal:/mlc:usb:dj450") and the current CVS of HPOJ uses two
  3405.     # slashes ("ptal://mlc:usb:dj450"). Correct the user-supplied URI
  3406.     # according to what "lpinfo -v" reports.
  3407.  
  3408.     my ($uri) = @_;
  3409.     $uri =~ m!^ptal://?([^/].*)$!;
  3410.     my $device = $1;
  3411.  
  3412.     # PTAL URIs listed by "lpinfo -v"
  3413.     open F, "$sysdeps->{'cups-lpinfo'} -v |" or return (@_);
  3414.     while (my $line = <F>) {
  3415.     chomp($line);
  3416.     my $d = quotemeta($device);
  3417.     if ($line =~ m!(ptal://?$d)$!) {
  3418.         my $realdevice = $1;
  3419.         close F;
  3420.         return $realdevice;
  3421.     }
  3422.     }
  3423.     close F;
  3424.  
  3425.     # Nothing found, do not correct the input
  3426.     return @_;
  3427. }
  3428.  
  3429. sub cups_generate_usb_device_lists {
  3430.     # Generate two lists: One of the actual USB device files in the
  3431.     # file system, another of the USB URIs listed by CUPS' "lpinfo -v"
  3432.  
  3433.     # Actual devices
  3434.     my @usbdevices;
  3435.     for my $pattern ("/dev/usb/lp*", "/dev/usb/usblp*") {
  3436.     open F, "ls -1 $pattern 2>/dev/null |" or next;
  3437.     @usbdevices = sort { Foomatic::DB::normalizename($a) cmp 
  3438.                  Foomatic::DB::normalizename($b) } 
  3439.                   grep { chomp } <F>;
  3440.     close F;
  3441.     last if $#usbdevices >= 0;
  3442.     }
  3443.     return ([], []) if $#usbdevices < 0;
  3444.  
  3445.     # USB URIs listed by "lpinfo -v"
  3446.     open F, "$sysdeps->{'cups-lpinfo'} -v |" or return ([], []);
  3447.     my @usburis = grep { s!^direct usb:!! and chomp } <F>;
  3448.     close F;
  3449.  
  3450.     return ([], []) if $#usburis < 0;
  3451.  
  3452.     # Results
  3453.     return (\@usbdevices, \@usburis);
  3454. }
  3455.  
  3456. sub cups_usb_device_uri_to_printer_uri {
  3457.  
  3458.     # Transfer a device file name into a printer-bound CUPS URI for
  3459.     # the printer currently connected
  3460.     my ($device) = @_;
  3461.     return $device if $device =~ m!^//!;
  3462.     my @devicelists = cups_generate_usb_device_lists();
  3463.     return $device if (($#{$devicelists[0]} < 0) ||
  3464.                ($#{$devicelists[1]} < 0));
  3465.     for (my $i = 0; $i <= $#{$devicelists[0]}; $i ++) {
  3466.     last if !$devicelists[1][$i];
  3467.     if ($device eq $devicelists[0][$i]) {
  3468.         return $devicelists[1][$i];
  3469.     }
  3470.     }
  3471.     return $device;
  3472. }
  3473.  
  3474. sub cups_usb_printer_uri_to_device_uri {
  3475.  
  3476.     # Transfer a device file name into a printer-bound CUPS URI for
  3477.     # the printer currently connected
  3478.     my ($device) = @_;
  3479.     return $device if $device =~ m!^/[^/]!;
  3480.     $device =~ s/ /\%20/g;
  3481.     my @devicelists = cups_generate_usb_device_lists();
  3482.     return $device if (($#{$devicelists[0]} < 0) ||
  3483.                ($#{$devicelists[1]} < 0));
  3484.     for (my $i = 0; $i <= $#{$devicelists[1]}; $i ++) {
  3485.     last if !$devicelists[0][$i];
  3486.     if ($device eq $devicelists[1][$i]) {
  3487.         return $devicelists[0][$i];
  3488.     }
  3489.     }
  3490.     return $device;
  3491. }
  3492.  
  3493. sub load_datablob {
  3494.  
  3495.     my ($spooler, $queue) = @_;
  3496.  
  3497.     my $spoolersubdir;
  3498.     my $datablob;
  3499.     if (($spooler eq "lpd") ||
  3500.     ($spooler eq "lprng")) {
  3501.     $datablob = load_lpd_datablob($queue);
  3502.     $spoolersubdir = 'lpd';
  3503.     } elsif ($spooler eq "cups") {
  3504.     $datablob = load_cups_datablob($queue);
  3505.     $spoolersubdir = 'cups';
  3506.     } elsif ($spooler eq "pdq") {
  3507.     $datablob = load_pdq_datablob($queue);
  3508.     $spoolersubdir = 'pdq';
  3509.     } elsif ($spooler eq "ppr") {
  3510.     $datablob = load_ppr_datablob($queue);
  3511.     $spoolersubdir = 'ppr';
  3512.     } elsif ($spooler eq "direct") {
  3513.     $datablob = load_direct_datablob($queue);
  3514.     $spoolersubdir = 'direct';
  3515.     } else {
  3516.     die "Unsupported spooler: $spooler\n";
  3517.     }
  3518.     # Is the given queue a valid queue?
  3519.     if (!$datablob) {
  3520.     return undef;
  3521.     }
  3522.     return ($datablob);
  3523. }
  3524.  
  3525. sub load_lpd_datablob {
  3526.     my ($queue) = $_[0];
  3527.     # Load the PPD file
  3528.     my $ppdfile = sprintf('%s/lpd/%s.ppd',
  3529.               $sysdeps->{'foo-etc'},
  3530.               $queue);
  3531.     my $dat = ppdtoperl($ppdfile);
  3532.     if (defined($dat)) {
  3533.     $dat->{'ppdfile'} = $ppdfile;
  3534.     }
  3535.     my $postpipe = (defined($dat) ? $dat->{'postpipe'} : "");
  3536.     # Get additional info from /etc/printcap
  3537.     my $pcap = load_lpd_printcap();
  3538.     my $p;
  3539.     for $p (@{$pcap}) {
  3540.     # enpty end entry for trailing comments
  3541.     next if !defined($p->{'names'});
  3542.     # Search for the correct queue
  3543.     next if ($queue ne $p->{'names'}[0]);
  3544.     # Collect values
  3545.     my $c = {};
  3546.     my $name = $c->{'queue'} = $p->{'names'}[0];
  3547.     $c->{'desc'} = $p->{'names'}[1] if $p->{'names'}[1];
  3548.     $c->{'loc'} = $p->{'names'}[3] if $p->{'names'}[3];
  3549.     $c->{'foomatic'} = 0;
  3550.     my $if = ($p->{'str'}{'if'} || "");
  3551.     if ($if =~ m!foomatic-rip$!) {
  3552.         $c->{'foomatic'} = 1;
  3553.         $c->{'printer'} = $dat->{'id'};
  3554.         $c->{'driver'} = $dat->{'driver'};
  3555.     }
  3556.     if (!$p->{'bool'}{'force_localhost'}) {
  3557.         # LPD
  3558.         $c->{'spooler'} = 'lpd';
  3559.     } else {
  3560.         # LPRng
  3561.         $c->{'spooler'} = 'lprng';
  3562.     }
  3563.     # TODO Raw queue for LPD
  3564. #    if (0 and $p->{'str'}{'if'} eq $file) {  # Raw queue with $postpipe
  3565. #        if (open FILE, "$file") {
  3566. #        # The first line is #!/bin/sh
  3567. #        $line = <FILE>;
  3568. #        # The second line is a comment
  3569. #        $line = <FILE>;
  3570. #        # The remaining line(s) are the $postpipe
  3571. #        $line = join('', <FILE>);
  3572. #        chomp $line;
  3573. #        $postpipe = "| $line";
  3574. #        close FILE;
  3575. #        }
  3576. #    }
  3577.     if (defined($postpipe)) {
  3578.         if ($postpipe =~ 
  3579.         m!^\s*\|\s*($sysdeps->{'cat'}|cat)\s+-?\s*>\s*([^\s]+)\s*$!) {
  3580.         my $file = $2;
  3581.         if (($file =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) ||
  3582.             ($file =~ m!^/dev/ptal-printd/(.+)$!) ||
  3583.             ($file =~ m!^/var/run/ptal-printd/(.+)$!)) {
  3584.             # Translate device for ptal-printd to ptal URI
  3585.             my $devname = $1;
  3586.             $devname =~ s/_/:/;
  3587.             $devname =~ s/_/:/;
  3588.             $c->{'connect'} = "ptal:/$devname";
  3589.         } elsif (($file =~ m!^$sysdeps->{'mtink-pipes'}/(.+)$!) ||
  3590.              ($file =~ m!^/var/mtink/(.+)$!)) {
  3591.             # Translate device for mtinkd to mtink URI
  3592.             $c->{'connect'} = "mtink:/$1";
  3593.         } elsif ($file =~ m!usb!i) {
  3594.             $c->{'connect'} = "usb:$file";
  3595.         } elsif ($file =~ m!(tty|serial)!i) {
  3596.             $c->{'connect'} = "serial:$file";
  3597.         } elsif ($file =~ m!(lp[0-9]|parallel)!i) {
  3598.             $c->{'connect'} = "parallel:$file";
  3599.         } else {
  3600.             $c->{'connect'} = "file:$file";
  3601.         }
  3602.         } elsif ($postpipe =~ 
  3603.         m!^\s*\|\s*($sysdeps->{'ptal-connect'}|ptal-connect|ptal-print)\s+(-print\s+|)([^\s]+)(\s+-print|)\s*$!){
  3604.         $c->{'connect'} = "ptal:/$3";
  3605.         } elsif ($postpipe =~ 
  3606.         m!^\s*\|\s*($sysdeps->{'nc'}|netcat|nc)\s+(-w\s*1\s+|)([^\s]+)\s+([^\s]+)\s*$!){
  3607.         $c->{'connect'} = "socket://$3:$4";
  3608.         } elsif ($postpipe =~ 
  3609.              m!^\s*\|\s*$sysdeps->{'rlpr'}\s.*-P\s*([^\s\\\@]+)\@([^\s\\\@]+)\s*$!) {
  3610.         $c->{'connect'} = "lpd://$2/$1";
  3611.         } elsif ($postpipe =~ 
  3612.              m!^.*\|\s*$sysdeps->{'smbclient'}\s+\"//([^/\s]+)/([^/\s]+)\"\s+(\S.*)$!s) {
  3613.         my $servershare = "$1/$2";
  3614.         my $parameters = $3;
  3615.         my $password = "";
  3616.         if ($parameters =~ m!^([^-]\S*)\s+(\S.*)$!) {
  3617.             $password = $1;
  3618.             $parameters = $2;
  3619.         }
  3620.         my $username = "";
  3621.         if ($parameters =~ m!^-U\s+(\S*)\s+(\S.*)$!) {
  3622.             $username = $1;
  3623.             $parameters = $2;
  3624.         }
  3625.         my $workgroup = "";
  3626.         if ($parameters =~ m!^-W\s+(\S*)\s+(\S.*)$!) {
  3627.             $workgroup = "$1/";
  3628.         }
  3629.         my $identity = "";
  3630.         if (($username eq "GUEST") && ($password eq "")) {
  3631.             $identity = "";
  3632.         } elsif (($username eq "") && ($password eq "")) {
  3633.             $identity = "";
  3634.         } elsif (($username ne "") && ($password eq "")) {
  3635.             $identity = "$username\@";
  3636.         } elsif (($username eq "") && ($password ne "")) {
  3637.             $identity = ":$password\@";
  3638.         } else {
  3639.             $identity = "$username:$password\@";
  3640.         }
  3641.         $c->{'connect'} = "smb://$identity$workgroup$servershare";
  3642.         } elsif ($postpipe =~ 
  3643.              m!^\s*\|\s*$sysdeps->{'nprint'}\s+(\S.*)$!s) {
  3644.         my $parameters = $1;
  3645.         my $server = "";
  3646.         if ($parameters =~ m!^-S\s+(\S*)\s+(\S.*)$!) {
  3647.             $server = $1;
  3648.             $parameters = $2;
  3649.         }
  3650.         my $username = "";
  3651.         if ($parameters =~ m!^-U\s+(\S*)\s+(\S.*)$!) {
  3652.             $username = $1;
  3653.             $parameters = $2;
  3654.         }
  3655.         my $password = "";
  3656.         if ($parameters =~ m!^-P\s+(\S*)\s+(\S.*)$!) {
  3657.             $password = $1;
  3658.             $parameters = $2;
  3659.         }
  3660.         if ($parameters =~ m!^-n\s+(\S.*)$!) {
  3661.             $parameters = $1;
  3662.         }
  3663.         my $queue = "";
  3664.         if ($parameters =~ m!^-q\s+(\S*)\s+(\S.*)$!) {
  3665.             $queue = $1;
  3666.         }
  3667.         my $identity = "";
  3668.         if (($username eq "") && ($password eq "")) {
  3669.             $identity = "";
  3670.         } elsif (($username ne "") && ($password eq "")) {
  3671.             $identity = "$username\@";
  3672.         } elsif (($username eq "") && ($password ne "")) {
  3673.             $identity = ":$password\@";
  3674.         } else {
  3675.             $identity = "$username:$password\@";
  3676.         }
  3677.         $c->{'connect'} = "ncp://$identity$server/$queue";
  3678.         } elsif( $postpipe ){
  3679.         $postpipe =~ m!\s*\|\s*(\S.*)$!;
  3680.         $c->{'connect'} = "postpipe:\"$1\"";
  3681.         }
  3682.     } else {
  3683.         my $lp = $p->{'str'}{'lp'};
  3684.         if (defined($lp) and $lp and $lp ne '/dev/null') {
  3685.         if (($lp =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) ||
  3686.             ($lp =~ m!^/dev/ptal-printd/(.+)$!) ||
  3687.             ($lp =~ m!^/var/run/ptal-printd/(.+)$!)) {
  3688.             # Translate device for ptal-printd to ptal URI
  3689.             my $devname = $1;
  3690.             $devname =~ s/_/:/;
  3691.             $devname =~ s/_/:/;
  3692.             $c->{'connect'} = "ptal:/$devname";
  3693.         } elsif (($lp =~ m!^$sysdeps->{'mtink-pipes'}/(.+)$!) ||
  3694.              ($lp =~ m!^/var/mtink/(.+)$!)) {
  3695.             # Translate device for mtinkd to mtink URI
  3696.             $c->{'connect'} = "mtink:/$1";
  3697.         } elsif ($lp =~ m!^\w+:!i) {
  3698.             $c->{'connect'} = $lp;
  3699.         } else {
  3700.             $c->{'connect'} = "file:$lp";
  3701.         }
  3702.         }
  3703.         my ($rm, $rp) = ($p->{'str'}{'rm'}, $p->{'str'}{'rp'});
  3704.         if (defined($rm) and defined($rp)) {
  3705.         $c->{'connect'} = "lpd://$rm/$rp";
  3706.         }
  3707.     }
  3708.     $dat->{'queuedata'} = $c;
  3709.     }
  3710.     if (!defined($dat->{'queuedata'})) {$dat = undef};
  3711.     return $dat;
  3712. }
  3713.  
  3714. sub load_cups_datablob {
  3715.     my ($queue) = $_[0];
  3716.     # Load the PPD file
  3717.     my $ppdfile = sprintf('%s/ppd/%s.ppd',
  3718.                $sysdeps->{'cups-etc'},
  3719.                $queue);
  3720.     #my $ppdfile = sprintf('%s/%s.ppd',
  3721.     #              $sysdeps->{'foo-etc'},
  3722.     #              $queue);
  3723.     my $dat = ppdtoperl($ppdfile);
  3724.     if (defined($dat)) {
  3725.     $dat->{'ppdfile'} = $ppdfile;
  3726.     }
  3727.     # Get additional info from /etc/cups/printers.conf
  3728.     my $pconf = load_cups_printersconf();
  3729.     my $p;
  3730.     for $p (@{$pconf}) {
  3731.     
  3732.     # were we invoked for only one queue?
  3733.     next if ($queue ne $p->{'name'});
  3734.  
  3735.     # Collect values
  3736.     my $c = {};
  3737.     $c->{'spooler'} = 'cups';
  3738.     $c->{'queue'} = $p->{'name'};
  3739.     $c->{'foomatic'} = 0;
  3740.     if (defined($dat->{'id'}) and defined($dat->{'driver'})) {
  3741.         $c->{'foomatic'} = 1;
  3742.         $c->{'printer'} = $dat->{'id'};
  3743.         $c->{'driver'} = $dat->{'driver'};
  3744.     }
  3745.     $c->{'desc'} = $p->{'Info'};
  3746.     $c->{'loc'} = $p->{'Location'};
  3747.     my $uri = $p->{'DeviceURI'};
  3748.     # Is the beh (Backend Error Handler) wrapper backend in use?
  3749.     # If yes, read out its parameters and isolate the original URI.
  3750.     if ($uri =~ m!^beh:/(\d+)/(\d+)/(\d+)/(\S+)$!) {
  3751.         $c->{'dd'} = $1;
  3752.         $c->{'att'} = $2;
  3753.         $c->{'delay'} = $3;
  3754.         $uri = $4;
  3755.     } else {
  3756.         $c->{'dd'} = 0;
  3757.         $c->{'att'} = 1;
  3758.         $c->{'delay'} = 30;
  3759.     }
  3760.     if (($uri =~ m!^file:$sysdeps->{'ptal-pipes'}/(.+)$!) ||
  3761.         ($uri =~ m!^file:/dev/ptal-printd/(.+)$!) ||
  3762.         ($uri =~ m!^file:/var/run/ptal-printd/(.+)$!)) {
  3763.         # Translate URI for ptal-printd to ptal URI
  3764.         my $devname = $1;
  3765.         $devname =~ s/_/:/;
  3766.         $devname =~ s/_/:/;
  3767.         $uri = "ptal:/$devname";
  3768.     } elsif (($uri =~ m!^file:$sysdeps->{'mtink-pipes'}/(.+)$!) ||
  3769.          ($uri =~ m!^file:/var/mtink/(.+)$!)) {
  3770.         # Translate URI for mtinkd to mtink URI
  3771.         $uri = "mtink:/$1";
  3772.     }
  3773.     $c->{'connect'} = $uri;
  3774.     # CUPS-specific extra info
  3775.     $c->{'quotaperiod'} = $p->{'QuotaPeriod'}
  3776.         if defined($p->{'QuotaPeriod'});
  3777.     $c->{'pagelimit'} = $p->{'PageLimit'}
  3778.         if defined($p->{'PageLimit'});
  3779.     $c->{'klimit'} = $p->{'KLimit'}
  3780.         if defined($p->{'KLimit'});
  3781.     # CUPS 1.2-specific settings
  3782.     $c->{'laststatechange'} = $p->{'StateTime'}
  3783.         if defined($p->{'StateTime'});
  3784.     $c->{'shared'} = $p->{'Shared'}
  3785.         if defined($p->{'Shared'});
  3786.     $c->{'operationpolicy'} = $p->{'OpPolicy'}
  3787.         if defined($p->{'OpPolicy'});
  3788.     $c->{'errorpolicy'} = $p->{'ErrorPolicy'}
  3789.         if defined($p->{'ErrorPolicy'});
  3790.     $dat->{'queuedata'} = $c;
  3791.     }
  3792.     if (!defined($dat->{'queuedata'})) {$dat = undef};
  3793.     return $dat;
  3794. }
  3795.  
  3796. sub load_pdq_datablob {
  3797.     my ($queue) = $_[0];
  3798.     # Load the PPD file
  3799.     my $ppdfile = sprintf('%s/pdq/%s.ppd',
  3800.               $sysdeps->{'foo-etc'},
  3801.               $queue);
  3802.     my $dat = ppdtoperl($ppdfile);
  3803.     if (defined($dat)) {
  3804.     $dat->{'ppdfile'} = $ppdfile;
  3805.     }
  3806.     if (defined($dat)) {
  3807.     my $printrc = load_pdq_printrc();
  3808.     my $p;
  3809.     my $pdqopts;
  3810.     my $pdqargs;
  3811.     for $p (@{$printrc}) {
  3812.         # Omit non-printer-block items
  3813.         next if (!(defined($p->{'name'})));
  3814.         # Search the current queue
  3815.         next if ($queue ne $p->{'name'});
  3816.         $pdqopts = $p->{'driver_opts'};
  3817.         $pdqargs = $p->{'driver_args'};
  3818.     }
  3819.     my @printrcdefaults = split(",", $pdqopts);
  3820.     push (@printrcdefaults, split(",", $pdqargs));
  3821.     
  3822.     my $c;
  3823.     @{$c->{'options'}} = ();
  3824.     for my $option (@printrcdefaults) {
  3825.         if ($option =~
  3826.         m!^\s*\{?\s*\"(OPT_|)(.+?)\"\s*=\s*\"(.*)\"\s*\}?\s*$!) {
  3827.         push (@{$c->{'options'}}, "$2=$3");
  3828.         } elsif ($option =~
  3829.              m!^\s*\{?\s*\"(OPT_|)([^_]+?)_(.+?)\"\s*\}?\s*$!) {
  3830.         push (@{$c->{'options'}}, "$2=$3");
  3831.         } elsif ($option =~ m!^\s*\{?\s*\"(OPT_|)(.+?)\"\s*\}?\s*$!) {
  3832.         push (@{$c->{'options'}}, "$2");
  3833.         }
  3834.     }
  3835.     set_default_options($c, $dat);
  3836.     }
  3837.     # Get additional info from printrc
  3838.     my $printrc = load_pdq_printrc();
  3839.     my $p;
  3840.     for $p (@{$printrc}) {
  3841.     # Omit non-printer-block items
  3842.     next if (!(defined($p->{'name'})));
  3843.     # Search for the appropriate queue
  3844.     next if ($queue ne $p->{'name'});
  3845.     my $c = {};
  3846.     $c->{'spooler'} = 'pdq';
  3847.     $c->{'queue'} = $p->{'name'};
  3848.     $c->{'foomatic'} = 0;
  3849.     if (defined($dat->{'id'}) and defined($dat->{'driver'})) {
  3850.         $c->{'foomatic'} = 1;
  3851.         $c->{'printer'} = $dat->{'id'};
  3852.         $c->{'driver'} = $dat->{'driver'};
  3853.     }
  3854.     if (defined($p->{'model'})) {
  3855.         my $desc = $p->{'model'};
  3856.         $desc =~ s!^\"!!;
  3857.         $desc =~ s!\"$!!;
  3858.         if ($desc ne '') {$c->{'desc'} = $desc;}
  3859.     }
  3860.     if (defined($p->{'location'})) {
  3861.         my $loc = $p->{'location'};
  3862.         $loc =~ s!^\"!!;
  3863.         $loc =~ s!\"$!!;
  3864.         if ($loc ne '') {$c->{'loc'} = $loc;}
  3865.     }
  3866.     if ($p->{'interface'} =~ m!local-port!) {
  3867.         # Local printer
  3868.         $p->{'interface_args'} =~ m!\"?PORT\"?\s*=\s*\"?([^\"\s]+)\"?!;
  3869.         my $file = $1;
  3870.         if (($file =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) ||
  3871.         ($file =~ m!^/dev/ptal-printd/(.+)$!) ||
  3872.         ($file =~ m!^/var/run/ptal-printd/(.+)$!)) {
  3873.         # Translate device for ptal-printd to ptal URI
  3874.         my $devname = $1;
  3875.         $devname =~ s/_/:/;
  3876.         $devname =~ s/_/:/;
  3877.         $c->{'connect'} = "ptal:/$devname";
  3878.         } elsif (($file =~ m!^$sysdeps->{'mtink-pipes'}/(.+)$!) ||
  3879.              ($file =~ m!^/var/mtink/(.+)$!)) {
  3880.         # Translate device for mtinkd to mtink URI
  3881.         $c->{'connect'} = "mtink:/$1";
  3882.         } elsif ($file =~ m!usb!i) {
  3883.         $c->{'connect'} = "usb:$file";
  3884.         } elsif ($file =~ m!(tty|serial)!i) {
  3885.         $c->{'connect'} = "serial:$file";
  3886.         } elsif ($file =~ m!(lp[0-9]|parallel)!i) {
  3887.         $c->{'connect'} = "parallel:$file";
  3888.         } else {
  3889.         $c->{'connect'} = "file:$file";
  3890.         }
  3891.     } elsif ($p->{'interface'} =~ m!bsd-lpd!) {
  3892.         # Remote LPD
  3893.         $p->{'interface_args'} =~
  3894.         m!\"?REMOTE_HOST\"?\s*=\s*\"?([^\"\s]+)\"?!;
  3895.         my $remhost = $1;
  3896.         $p->{'interface_args'} =~
  3897.         m!\"?QUEUE\"?\s*=\s*\"?([^\"\s]+)\"?!;
  3898.         my $remqueue = $1;
  3899.         $c->{'connect'} = "lpd://$remhost/$remqueue";
  3900.     } elsif ($p->{'interface'} =~ m!tcp-port!) {
  3901.         # Socket
  3902.         $p->{'interface_args'} =~
  3903.         m!\"?REMOTE_HOST\"?\s*=\s*\"?([^\"\s]+)\"?!;
  3904.         my $remhost = $1;
  3905.         $p->{'interface_args'} =~
  3906.         m!\"?REMOTE_PORT\"?\s*=\s*\"?([^\"\s]+)\"?!;
  3907.         my $remport = $1;
  3908.         $c->{'connect'} = "socket://$remhost:$remport";
  3909.     }
  3910.     $dat->{'queuedata'} = $c;
  3911.     }
  3912.     if (!defined($dat->{'queuedata'})) {$dat = undef};
  3913.     return $dat;
  3914. }
  3915.  
  3916. sub load_ppr_datablob {
  3917.     my ($queue) = $_[0];
  3918.     # Load the PPD file
  3919.     my $ppdfile = sprintf('%s/ppr/%s.ppd',
  3920.               $sysdeps->{'foo-etc'},
  3921.               $queue);
  3922.     my $dat = ppdtoperl($ppdfile);
  3923.     if (defined($dat)) {
  3924.     $dat->{'ppdfile'} = $ppdfile;
  3925.     }
  3926.     # Get additional info from /etc/ppr/*
  3927.     my $pconf = load_ppr_printers_conf();
  3928.     my $p;
  3929.     for $p (@{$pconf}) {
  3930.  
  3931.     # were we invoked for only one queue?
  3932.     next if ($queue ne $p->{'name'});
  3933.  
  3934.     # Collect values
  3935.     my $c = {};
  3936.     $c->{'spooler'} = 'ppr';
  3937.     $c->{'queue'} = $p->{'name'};
  3938.     $c->{'foomatic'} = 0;
  3939.     if (defined($dat->{'id'}) and defined($dat->{'driver'})) {
  3940.         $c->{'foomatic'} = 1;
  3941.         $c->{'printer'} = $dat->{'id'};
  3942.         $c->{'driver'} = $dat->{'driver'};
  3943.     }
  3944.     $c->{'desc'} = $p->{'Comment'};
  3945.     $c->{'loc'} = $p->{'Location'};
  3946.     if (defined($dat)) {
  3947.         my @printerdefaults = split('|', $p->{'Switchset'});
  3948.         my $o;
  3949.         @{$o->{'options'}} = ();
  3950.         for my $option (@printerdefaults) {
  3951.         if (($option =~ 
  3952.              /^F\s*\*([^\*\s=:]+)\s+([^\*\s=:]+)\s*$/) ||
  3953.             ($option =~ 
  3954.              /^F\s*([^\*\s=:]+)\s*=\s*([^\*\s=:]+)\s*$/)) {
  3955.             push (@{$o->{'options'}}, "$1=$2");
  3956.         } elsif (($option =~ /^F\s*\*([^\*\s=:]+)\s*$/) ||
  3957.              ($option =~ /^F\s*([^\*\s=:]+)\s*$/)) {    
  3958.             push (@{$o->{'options'}}, "$1");
  3959.         }
  3960.         }
  3961.         set_default_options($o, $dat);
  3962.     }
  3963.     my $address = $p->{'Address'};
  3964.     my $interface = $p->{'Interface'};
  3965.     my $interface_options = $p->{'Options'};
  3966.     if (($interface eq "foomatic-rip") ||
  3967.         ($interface eq "ppromatic")) {
  3968.         if ($interface_options =~ /backend=(\S+)/) {
  3969.         $interface = $1;
  3970.         $interface_options =~ s/backend=(\S+)//;
  3971.         if ($interface_options =~ /^\s*$/) {
  3972.             $interface_options = "";
  3973.         }
  3974.         } else {
  3975.         $interface = "";
  3976.         }
  3977.     }
  3978.     my $uri = "";
  3979.     if (($interface eq "simple") || ($interface eq "parallel") ||
  3980.         ($interface eq "serial") || ($interface eq "dummy")) {
  3981.         # local printer
  3982.         if (($address =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) ||
  3983.         ($address =~ m!^/dev/ptal-printd/(.+)$!) ||
  3984.         ($address =~ m!^/var/run/ptal-printd/(.+)$!)) {
  3985.         # Translate device for ptal-printd to ptal URI
  3986.         my $devname = $1;
  3987.         $devname =~ s/_/:/;
  3988.         $devname =~ s/_/:/;
  3989.         $uri = "ptal:/$devname";
  3990.         } elsif (($address =~ m!^$sysdeps->{'mtink-pipes'}/(.+)$!) ||
  3991.              ($address =~ m!^/var/mtink/(.+)$!)) {
  3992.         # Translate device for mtinkd to mtink URI
  3993.         $uri = "mtink:/$1";
  3994.         } elsif ($address =~ m!^\w+:!i) {
  3995.         $c->{'connect'} = $address;
  3996.         } else {
  3997.         $uri = "file:$address";
  3998.         }
  3999.     } elsif ($interface eq "lpr") {
  4000.         # Remote LPD
  4001.         if ($address =~ /^([^\@]+)\@([^\@]+)$/) {
  4002.         my $remhost = $2;
  4003.         my $remqueue = $1;
  4004.         $uri = "lpd://$remhost/$remqueue";
  4005.         } else {
  4006.         die "Remote LPD configuration of the queue $p->{'name'} " .
  4007.             "broken!\n";
  4008.         }
  4009.     } elsif ($interface eq "tcpip") {
  4010.         # Socket (AppSocket/HP JetDirect)
  4011.         $uri = "socket://$address";
  4012.     } elsif ($interface eq "smb") {
  4013.         # SMB (Printer on Windows server)
  4014.         if ($address =~ m!^//([^/]+)/([^/]+)$!) {
  4015.         my $smbserver = $1;
  4016.         my $smbshare = $2;
  4017.         my $smbuser = "";
  4018.         if ($interface_options =~ /smbuser=(\S+)/) {
  4019.             $smbuser = $1;
  4020.         } else {
  4021.             # The PPR interface for SMB uses the user name "ppr"
  4022.             # when no user name is given.
  4023.             $smbuser = "ppr";
  4024.         }
  4025.         my $smbpassword = "";
  4026.         if ($interface_options =~ /smbpassword=(\S+)/) {
  4027.             $smbpassword = $1;
  4028.         }
  4029.         if (($smbpassword ne "") && ($smbuser eq "")) {
  4030.             $smbuser = "GUEST";
  4031.         }
  4032.         $uri = "$smbserver/$smbshare";
  4033.         if ($smbuser ne "") {
  4034.             if ($smbpassword ne "") {
  4035.             $smbuser .= ":$smbpassword";
  4036.             }
  4037.             $uri = "$smbuser\@$uri";
  4038.         }
  4039.         $uri = "smb://$uri";
  4040.         } else {
  4041.         die "SMB configuration of the queue $p->{'name'} broken!\n";
  4042.         }
  4043.     } else {
  4044.         # Interface not supported by Foomatic
  4045.         $uri = "$interface:$address";
  4046.     }
  4047.     $c->{'connect'} = $uri;
  4048.     $dat->{'queuedata'} = $c;
  4049.     }
  4050.     if (!defined($dat->{'queuedata'})) {$dat = undef};
  4051.     return $dat;
  4052. }
  4053.  
  4054. sub load_direct_datablob {
  4055.     my ($queue) = $_[0];
  4056.     # Load the PPD file
  4057.     my $ppdfile = sprintf('%s/direct/%s.ppd',
  4058.               $sysdeps->{'foo-etc'},
  4059.               $queue);
  4060.     my $dat = ppdtoperl($ppdfile);
  4061.     if (defined($dat)) {
  4062.     $dat->{'ppdfile'} = $ppdfile;
  4063.     }
  4064.     my $postpipe = (defined($dat) ? $dat->{'postpipe'} : "");
  4065.     # Get additional info from /etc/foomatic/direct/.config
  4066.     my $config = load_direct_config();
  4067.     my $p;
  4068.     for $p (@{$config}) {
  4069.     # invalid entry
  4070.     next if !defined($p->{'name'});
  4071.     # Search for the correct queue
  4072.     next if ($queue ne $p->{'name'});
  4073.     # Collect values
  4074.     my $c = {};
  4075.     my $name = $c->{'queue'} = $p->{'name'};
  4076.     $c->{'desc'} = $p->{'desc'};
  4077.     $c->{'loc'} = $p->{'loc'};
  4078.     $c->{'foomatic'} = 0;
  4079.     if (defined($dat->{'id'}) and defined($dat->{'driver'})) {
  4080.         $c->{'foomatic'} = 1;
  4081.         $c->{'printer'} = $dat->{'id'};
  4082.         $c->{'driver'} = $dat->{'driver'};
  4083.     }
  4084.     $c->{'spooler'} = 'direct';
  4085.     if (defined($postpipe)) {
  4086.         if ($postpipe =~ 
  4087.         m!^\s*\|\s*($sysdeps->{'cat'}|cat)\s+-?\s*>\s*([^\s]+)\s*$!) {
  4088.         my $file = $2;
  4089.         if (($file =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) ||
  4090.             ($file =~ m!^/dev/ptal-printd/(.+)$!) ||
  4091.             ($file =~ m!^/var/run/ptal-printd/(.+)$!)) {
  4092.             # Translate device for ptal-printd to ptal URI
  4093.             my $devname = $1;
  4094.             $devname =~ s/_/:/;
  4095.             $devname =~ s/_/:/;
  4096.             $c->{'connect'} = "ptal:/$devname";
  4097.         } elsif (($file =~ m!^$sysdeps->{'mtink-pipes'}/(.+)$!) ||
  4098.             ($file =~ m!^/var/mtink/(.+)$!)) {
  4099.             # Translate device for mtinkd to mtink URI
  4100.             $c->{'connect'} = "mtink:/$1";
  4101.         } elsif ($file =~ m!usb!i) {
  4102.             $c->{'connect'} = "usb:$file";
  4103.         } elsif ($file =~ m!(tty|serial)!i) {
  4104.             $c->{'connect'} = "serial:$file";
  4105.         } elsif ($file =~ m!(lp[0-9]|parallel)!i) {
  4106.             $c->{'connect'} = "parallel:$file";
  4107.         } else {
  4108.             $c->{'connect'} = "file:$file";
  4109.         }
  4110.         } elsif ($postpipe =~ 
  4111.         m!^\s*\|\s*($sysdeps->{'ptal-connect'}|ptal-connect|ptal-print)\s+(-print\s+|)([^\s]+)(\s+-print|)\s*$!){
  4112.         $c->{'connect'} = "ptal:/$3";
  4113.         } elsif ($postpipe =~ 
  4114.         m!^\s*\|\s*($sysdeps->{'nc'}|netcat|nc)\s+(-w\s*1\s+|)([^\s]+)\s+([^\s]+)\s*$!){
  4115.         $c->{'connect'} = "socket://$3:$4";
  4116.         } elsif ($postpipe =~ 
  4117.              m!^\s*\|\s*$sysdeps->{'rlpr'}\s.*-P\s*([^\s\\\@]+)\@([^\s\\\@]+)\s*$!) {
  4118.         $c->{'connect'} = "lpd://$2/$1";
  4119.         } elsif ($postpipe =~ 
  4120.              m!^.*\|\s*$sysdeps->{'smbclient'}\s+\"//([^/\s]+)/([^/\s]+)\"\s+(\S.*)$!s) {
  4121.         my $servershare = "$1/$2";
  4122.         my $parameters = $3;
  4123.         my $password = "";
  4124.         if ($parameters =~ m!^([^-]\S*)\s+(\S.*)$!) {
  4125.             $password = $1;
  4126.             $parameters = $2;
  4127.         }
  4128.         my $username = "";
  4129.         if ($parameters =~ m!^-U\s+(\S*)\s+(\S.*)$!) {
  4130.             $username = $1;
  4131.             $parameters = $2;
  4132.         }
  4133.         my $workgroup = "";
  4134.         if ($parameters =~ m!^-W\s+(\S*)\s+(\S.*)$!) {
  4135.             $workgroup = "$1/";
  4136.         }
  4137.         my $identity = "";
  4138.         if (($username eq "GUEST") && ($password eq "")) {
  4139.             $identity = "";
  4140.         } elsif (($username eq "") && ($password eq "")) {
  4141.             $identity = "";
  4142.         } elsif (($username ne "") && ($password eq "")) {
  4143.             $identity = "$username\@";
  4144.         } elsif (($username eq "") && ($password ne "")) {
  4145.             $identity = ":$password\@";
  4146.         } else {
  4147.             $identity = "$username:$password\@";
  4148.         }
  4149.         $c->{'connect'} = "smb://$identity$workgroup$servershare";
  4150.         } elsif ($postpipe =~ 
  4151.              m!^\s*\|\s*$sysdeps->{'nprint'}\s+(\S.*)$!s) {
  4152.         my $parameters = $1;
  4153.         my $server = "";
  4154.         if ($parameters =~ m!^-S\s+(\S*)\s+(\S.*)$!) {
  4155.             $server = $1;
  4156.             $parameters = $2;
  4157.         }
  4158.         my $username = "";
  4159.         if ($parameters =~ m!^-U\s+(\S*)\s+(\S.*)$!) {
  4160.             $username = $1;
  4161.             $parameters = $2;
  4162.         }
  4163.         my $password = "";
  4164.         if ($parameters =~ m!^-P\s+(\S*)\s+(\S.*)$!) {
  4165.             $password = $1;
  4166.             $parameters = $2;
  4167.         }
  4168.         if ($parameters =~ m!^-n\s+(\S.*)$!) {
  4169.             $parameters = $1;
  4170.         }
  4171.         my $queue = "";
  4172.         if ($parameters =~ m!^-q\s+(\S*)\s+(\S.*)$!) {
  4173.             $queue = $1;
  4174.         }
  4175.         my $identity = "";
  4176.         if (($username eq "") && ($password eq "")) {
  4177.             $identity = "";
  4178.         } elsif (($username ne "") && ($password eq "")) {
  4179.             $identity = "$username\@";
  4180.         } elsif (($username eq "") && ($password ne "")) {
  4181.             $identity = ":$password\@";
  4182.         } else {
  4183.             $identity = "$username:$password\@";
  4184.         }
  4185.         $c->{'connect'} = "ncp://$identity$server/$queue";
  4186.         } else {
  4187.         $postpipe =~ m!\s*\|\s*(\S.*)$!;
  4188.         $c->{'connect'} = "postpipe:\"$1\"";
  4189.         }
  4190.     } else {
  4191.         $c->{'connect'} = "stdout";
  4192.     }
  4193.     $dat->{'queuedata'} = $c;
  4194.     }
  4195.     if (!defined($dat->{'queuedata'})) {$dat = undef};
  4196.     return $dat;
  4197. }
  4198.  
  4199. sub overtake_defaults {
  4200.     # overtake the option default settings from $olddatablob
  4201.     my ($olddatablob) = $_[0];
  4202.     my $c;
  4203.     @{$c->{'options'}} = ();
  4204.     for my $opt (@{$olddatablob->{'args'}}) {
  4205.     push (@{$c->{'options'}}, "$opt->{'name'}=$opt->{'default'}");
  4206.     }
  4207.     set_default_options($c, $db->{'dat'});
  4208. }
  4209.  
  4210. sub set_default_options {
  4211.  
  4212.     # Set the default printing options by doing changes on the Perl
  4213.     # structure produced by "getdat", before the spooler-specific
  4214.     # datafile is generated
  4215.  
  4216.     my ($config) = $_[0];
  4217.     my ($dest) = $_[1];
  4218.  
  4219.     if ($#{$config->{'options'}} >= 0) {
  4220.     for (@{$config->{'options'}}) {
  4221.         my $option = $_;
  4222.         if ($option =~ m!^\s*([^=]+)=([^=]*)\s*$!) {
  4223.         # evaluated or numerical option, boolean option with
  4224.         # value "True", "False", "Yes", "No", "On", "Off", "1", "0" 
  4225.         # given
  4226.         my $optname = $1;
  4227.         my $optvalue = $2;
  4228.            if (defined($dest->{'args_byname'}{$optname})) {
  4229.             if ($dest->{'args_byname'}{$optname}{'type'} eq
  4230.             'bool') {
  4231.             if ((lc($optvalue) eq 'true') ||
  4232.                 (lc($optvalue) eq 'on') ||
  4233.                 (lc($optvalue) eq 'yes')) {
  4234.                 $optvalue = '1';
  4235.             } elsif ((lc($optvalue) eq 'false') ||
  4236.                  (lc($optvalue) eq 'off') ||
  4237.                  (lc($optvalue) eq 'no')) {
  4238.                 $optvalue = '0';
  4239.             }
  4240.             if (($optvalue eq '1') || ($optvalue eq '0')) {
  4241.                 $dest->{'args_byname'}{$optname}{'default'} = 
  4242.                 $optvalue;
  4243.             }
  4244.             } elsif (($dest->{'args_byname'}{$optname}{'type'} eq
  4245.                   'int') || 
  4246.                  ($dest->{'args_byname'}{$optname}{'type'} eq
  4247.                   'float')) {
  4248.             if (($optvalue =~ 
  4249.                  m!^\s*[\+\-]?\s*[0-9]*\.?[0-9]*\s*$!) &&
  4250.                 ($optvalue >=
  4251.                  $dest->{'args_byname'}{$optname}{'min'}) &&
  4252.                 ($optvalue <=
  4253.                  $dest->{'args_byname'}{$optname}{'max'})) {
  4254.                 $dest->{'args_byname'}{$optname}{'default'} = 
  4255.                 $optvalue;
  4256.             }
  4257.             } elsif (($dest->{'args_byname'}{$optname}{'type'} eq
  4258.                   'string') || 
  4259.                  ($dest->{'args_byname'}{$optname}{'type'} eq
  4260.                   'password')) {
  4261.             $optvalue = Foomatic::DB::checkoptionvalue
  4262.                 ($dest, $optname, $optvalue, 0);
  4263.             $dest->{'args_byname'}{$optname}{'default'} = 
  4264.                 $optvalue
  4265.                 if defined($optvalue);
  4266.             } else {
  4267.             if (defined($dest->{'args_byname'}{$optname}{'vals_byname'}{$optvalue})) {
  4268.                 $dest->{'args_byname'}{$optname}{'default'} = 
  4269.                 $optvalue;
  4270.             }
  4271.             }
  4272.         }
  4273.         } else {
  4274.         if (($option =~ /^no(.+?)$/) && 
  4275.             (defined($dest->{'args_byname'}{$1})) &&
  4276.             ($dest->{'args_byname'}{$1}{'type'} eq
  4277.              'bool')) {
  4278.             $dest->{'args_byname'}{$1}{'default'} = '0';
  4279.         } elsif ((defined($dest->{'args_byname'}{$option})) &&
  4280.             ($dest->{'args_byname'}{$option}{'type'} eq
  4281.              'bool')) {
  4282.             $dest->{'args_byname'}{$option}{'default'} = '1';
  4283.         }
  4284.         }
  4285.     }
  4286.     }
  4287. }
  4288.  
  4289. sub print_perl_combo_data {
  4290.     my ($config, $olddatablob) = @_;
  4291.  
  4292.     # Get the data
  4293.     if ($config->{'ppdfile'}) { 
  4294.     # From PPD file
  4295.     my $dat = ppdtoperl($config->{'ppdfile'});
  4296.     if (!defined($dat)) {
  4297.         die ("Unable to open PPD file \'$config->{'ppdfile'}\'\n");
  4298.     }
  4299.     $db->{'dat'} = $dat;
  4300.     } else {
  4301.     # From Foomatic XML database
  4302.     my $possible = $db->getdat($config->{'driver'}, 
  4303.                    $config->{'printer'});
  4304.     die "That printer and driver combination is not possible.\n"
  4305.         if (!$possible);
  4306.     die "There is neither a custom PPD file nor the driver database entry contains sufficient data to build a PPD file.\n"
  4307.         if (!$db->{'dat'}{'cmd'}) && (!$db->{'dat'}{'ppdfile'});
  4308.     # Generate the PPD and extract it to Perl again (to get in the
  4309.     # composite options)
  4310.     my $ppd = $db->getppd($config->{'shortgui'});
  4311.     delete ($db->{'dat'});
  4312.     $db->{'dat'} = ppdfromvartoperl([split(/\n/, $ppd)]);
  4313.     }
  4314.  
  4315.     # The data can be viewed with the option defaults of an existing
  4316.     # queue set
  4317.     if ($olddatablob) {
  4318.     my $c;
  4319.     @{$c->{'options'}} = ();
  4320.     for my $opt (@{$olddatablob->{'args'}}) {
  4321.         push (@{$c->{'options'}}, "$opt->{'name'}=$opt->{'default'}");
  4322.     }
  4323.     set_default_options($c, $db->{'dat'});
  4324.     }
  4325.  
  4326.     # User can view the data of the combo also with options given on the
  4327.     # command line
  4328.     set_default_options($config, $db->{'dat'});
  4329.  
  4330.     # Put it out
  4331.     my $asciidata = $db->getascii();
  4332.     $asciidata =~ s/\$VAR1/\$COMBODATA/g;
  4333.     print $asciidata;
  4334.     return;
  4335.     
  4336. }
  4337.  
  4338. sub detect_spooler {
  4339.  
  4340.     # If tcp/localhost:631 opens, cups CUPS is the most sophisticated
  4341.     # spooler, if it is running, it is usually the primary printing
  4342.     # system
  4343.     my $page = ($db->getpage('http://localhost:631/', 1) || "");
  4344.     if ($page =~ m!Common UNIX Printing System!) {
  4345.     return 'cups';
  4346.     }
  4347.  
  4348.     # PPR is also very sophisticated so check for this spooler if there is
  4349.     # no CUPS running.
  4350.     if (-x $sysdeps->{'ppr-ppr'}) {
  4351.     # There's a /usr/bin/ppr
  4352.     return 'ppr';
  4353.     }
  4354.     
  4355.     # Else if /etc/printcap, some sort of lpd thing
  4356.     if (-f $sysdeps->{'lpd-pcap'}) {
  4357.     # If -f /etc/lpd.conf, lprng
  4358.     if (-f $sysdeps->{'lprng-conf'}) {
  4359.         return 'lprng';
  4360.     } elsif (-x $sysdeps->{'lpd-bin'}) {
  4361.         # There's a /usr/sbin/lpd
  4362.         return 'lpd';
  4363.     }
  4364.     }
  4365.  
  4366.     # pdq executable in our path somewhere?
  4367.     for (split(':', $ENV{'PATH'})) {
  4368.     if (-x "$_/pdq") {
  4369.         return 'pdq';
  4370.     }
  4371.     }
  4372.  
  4373.     # If there is no known spooler, set up printers for direct, spooler-less
  4374.     # printing.
  4375.     return "direct";
  4376. }
  4377.  
  4378. sub unimp {
  4379.     die "Sorry, $action for your spooler is unimplemented...\n";
  4380. }
  4381.  
  4382. sub overview {
  4383.     print $db->get_overview_xml($opt_f);
  4384.     exit(0);
  4385. }
  4386.  
  4387. sub get_xml {
  4388.     my $x = undef;
  4389.     if (($opt_p) and ($opt_d)) {
  4390.     $x = $db->get_combo_data_xml($opt_d,$opt_p);
  4391.     } elsif ($opt_p) {
  4392.         $x = $db->get_printer_xml($opt_p);
  4393.     } elsif ($opt_d) {
  4394.     $x = $db->get_driver_xml($opt_d);
  4395.     } else {
  4396.     die "You must specify a -p printer and/or -d driver.\n";
  4397.     }
  4398.  
  4399.     if (defined($x)) {
  4400.     print $x;
  4401.     } else {
  4402.     die "Unable to find object.\n";
  4403.     }
  4404.  
  4405.     exit(0);
  4406. }
  4407.  
  4408. sub help {
  4409.     print STDERR <<EOH;
  4410. Usage: $progname [ -s spooler ] -n queuename \\
  4411.               [ -N 'Name/Descr.' ] [ -L 'Location Info' ] \\
  4412.               [ -c connect ] \\
  4413.               [ -d driver ] [ -p printer ] [ -f ] [ -w ] \\
  4414.               [ --ppd ppdfile ] \\
  4415.               [ -o option1=value1 -o option2 ... ] \\
  4416.               [ --backend-dont-disable=value ] \\
  4417.               [ --backend-attempts=value ] \\
  4418.               [ --backend-delay=value ] \\
  4419.               [ -q ]
  4420.     or $progname -C [ -s spooler ] -n queuename \\
  4421.                       [ sourcespooler ] sourcequeue \\
  4422.                       [ -N 'Name/Descr.' ] [ -L 'Location Info' ] \\
  4423.               [ -c connect ] \\
  4424.               [ -d driver ] [ -p printer ] [ -f ] [ -w ] \\
  4425.               [ --ppd ppdfile ] \\
  4426.               [ -o option1=value1 -o option2 ... ] \\
  4427.               [ --backend-dont-disable=value ] \\
  4428.               [ --backend-attempts=value ] \\
  4429.               [ --backend-delay=value ] \\
  4430.               [ -q ]
  4431.     or $progname -D [ -s spooler ] -n queuename [ -q ]
  4432.     or $progname -R [ -s spooler ] -n queuename [ -q ]
  4433.     or $progname -Q [ -s spooler ] [ -n queuename ] [ -q ] [ -r ]
  4434.     or $progname -P [ -s spooler ] [ -n queuename ] [ -q ] [ N ]
  4435.     or $progname -P [ -s spooler ] [ -n queuename ] \\
  4436.                       [ --ppd ppdfile ] [ -d driver -p printer ] \\
  4437.                       [ -o option1=value1 -o option2 ... ] [ -q ]
  4438.     or $progname -O
  4439.     or $progname -X [ -p printer ] [ -d driver ]
  4440.  
  4441.  -n queuename    Configure/create/delete/query this print queue
  4442.  -N Name/Descr.  Long name/Short Description. An empty string ("") deletes
  4443.                  the description.
  4444.  -L Location     Short phrase describing this printer's location. An empty
  4445.                  string ("") deletes the location.
  4446.  -c connection   Printer is connected thusly (ex file:/dev/lp0), must
  4447.                  be given when a new queue is created
  4448.  --ppd ppdfile   Set up the queue using the PPD file ppdfile (can be a
  4449.                  manufacturer-supplied PPD file for a PostScript printer).
  4450.                  gzip-compressed PPD files are allowed, they must have the
  4451.                  extension ".gz".
  4452.  -d driver       Foomatic database name for desired printer driver or "raw"
  4453.                  for a raw queue. When a non-raw queue is created, the
  4454.                  printer must be specified in addition ("-p" option)
  4455.  -p printer      Foomatic id for printer. When a non-raw queue is created,
  4456.                  the driver must be specified in addition ("-d" option)
  4457.  -s spooler      Explicit spooler type (cups, lpd, lprng, pdq, ppr, direct)
  4458.  -o option=value Use value as the default for option in this queue
  4459.  -o option       Set the switch option by default in this queue
  4460.  --backend-dont-disable=value  1: Do not disable CUPS queue when backend
  4461.                  fails, 0: Original CUPS behaviour, queue gets disabled
  4462.                  when backend fails. Default: 0 (CUPS only)
  4463.  --backend-attempts=value  Try that often when backend fails, for infinite
  4464.                  retries set the value to zero, for standard CUPS
  4465.                  behaviour to 1. Default: 1 (CUPS only)
  4466.  --backend-delay=value  Delay in seconds between retries of failed backend.
  4467.                  Default: 30 (CUPS only)
  4468.  -C [sourcespooler] sourcequeue  Create a copy of a queue. All 
  4469.                  characteristics including default option settings are 
  4470.                  overtaken. Additional arguments modify the copy. This
  4471.                  facility allows to overtake one's configured queues when
  4472.                  one changes the spooler.
  4473.  -D              Set this queue as the queue used by default.
  4474.  -R              Remove this whole queue entirely (just give -n queuename)
  4475.  -Q              Query existing configuration (gives XML summary). Supplying
  4476.                  no queue name gives info about all installed queues for the
  4477.                  current/selected spooler, including the default queue.
  4478.  -r              list also remote queues (CUPS only).
  4479.  -P              Query existing configuration (gives Perl data structure of
  4480.                  the complete information about the queue, including
  4481.                  options, possible choices, default settings, ..., for use 
  4482.                  by frontends, the output is done as a Perl array, one
  4483.                  element per queue), With printer ID and driver name instead
  4484.                  of queue name supplied the Perl data structure of the 
  4485.                  appropriate printer/driver combo is generated, supplied
  4486.                  options are entered as default settings then, from a
  4487.                  supplied queue the option default settings are used.
  4488.                  Supplying no queue, printer, and driver gives info about
  4489.                  all installed queues for the current/selected spooler.
  4490.  N               The first index of the Perl array, default: 0
  4491.  -O              Print XML Overview of all known printer/drivers
  4492.  -X              Print XML data for -p printer and/or -d driver object
  4493.  -f              Force rebuild of PPD file from database
  4494.  -w              Generate PPD which is compatible to the CUPS PostScript
  4495.                  driver for Windows (GUI strings are limited to 39 characters).
  4496.                  This applies only to PPDs built from the Foomatic database, it
  4497.                  has no influence on PPDs supplied with the "--ppd" option.
  4498.  -q              Run quietly and non-interactive
  4499.  -h  --help      Show this help message
  4500.  
  4501. EOH
  4502.  
  4503. #'# Fix emacs syntax highlighting
  4504.  
  4505.     exit 0;
  4506. }
  4507.